Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Самогаснущие диалоговые окна в Ворде - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Самогаснущие диалоговые окна в Ворде (Макросы/Sub)
Самогаснущие диалоговые окна в Ворде
auto-teacher Дата: Вторник, 26.09.2017, 19:44 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 20
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Здравствуйте!
Есть макрос (даже не макрос, а целый модуль), который вызывает диалоговое окно, а потом оно само гаснет. Можно задать время отображения.
Раньше модуль отлично работал, а тут стал выдавать ошибку. То ли из-за перехода с 32-битной системы на 64-битную, то ли еще от чего.
Может быть, таймер по-другому надо вызывать. Я слабоват в этом деле.
Подскажите, пожалуйста, что надо исправить.
Код модуля такой:
[vba]
Код

'To display a timed Msgbox use the MsgboxOKDrop routine given below.
'By Andrew Baker

Option Explicit

'API calls for Msgbox2. Must be placed in a standard module
Declare PtrSafe Function SetTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare PtrSafe Function KillTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long) As Long
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Private zsMessageTitle As String, lTimerId As Long

'Purpose     :  Stops the timer routine
'Inputs      :  N/A
'Outputs     :  Returns True if the timer routine was stopped
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:24
'Notes       :  Code must be placed in a module
'Revisions   :

Function EndTimer() As Boolean
    If lTimerId Then
        lTimerId = KillTimer(0&, lTimerId)
        lTimerId = 0
        EndTimer = True
    End If
End Function

'Purpose     :  Starts the continuous calling of a private routine at a specific time interval.
'Inputs      :  lInterval           The interval (in ms) at which to call the routine
'Outputs     :  N/A
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:30
'Notes       :  Code must be placed in a module
'Revisions   :

Sub StartTimer(lInterval As Long)
    If lTimerId Then
        'End Current Timer
        EndTimer
    End If
    lTimerId = SetTimer(0&, 0&, ByVal lInterval, AddressOf TimerRoutine)
End Sub

'Purpose     :  Routine which is called repeatedly by the timer API.
'Inputs      :  Inputs are automatically generated.
'Outputs     :
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:32
'Notes       :
'Revisions   :

Private Sub TimerRoutine(ByVal lHwnd As Long, ByVal lMsg As Long, ByVal lIDEvent As Long, ByVal lTime As Long)
    Const WM_CLOSE = &H10
    Dim lHwndMsgbox As Long

    'Find the Msgbox
    lHwndMsgbox = FindWindow(vbNullString, zsMessageTitle)
    'Close Msgbox
    Call SendMessage(lHwndMsgbox, WM_CLOSE, 0, ByVal 0&)
End Sub

'Purpose     :  Extended version of Msgbox, has extra parameter to set time msgbox is displayed for
'Inputs      :  As per Msgbox
'               [DisplayTime]               The time in MS to display the message.
'Outputs     :  As per Msgbox
'Author      :  Andrew Baker
'Date        :  03/01/2001 13:23
'Notes       :
'Revisions   :

Function MsgboxOKDrop(Prompt As String, Buttons As VbMsgBoxStyle, Title As String, Optional DisplayTime As Long = 3000) As VbMsgBoxResult
    If DisplayTime > 0 Then
        'Enable the timer
        StartTimer DisplayTime
        zsMessageTitle = Title
    End If
    MsgboxOKDrop = MsgBox(Prompt, Buttons, Title)
    'Stop the timer
    EndTimer
End Function
[/vba]
Само сообщение вызывается таким кодом:
[vba]
Код

Sub СамогаснущееОкно()
    lRetVal = MsgboxOKDrop("Это окно должно само погаснуть!" & vbCrLf & "Сейчас, через 5 секунд, окно погаснет!", vbOKOnly + vbInformation, "Самогаснущее окно", 5000)
End Sub
[/vba]
При отладке ошибка выскакивает на строке выделенной желтым.
Фото прилагаются.
К сообщению приложен файл: 6569850.png (66.5 Kb) · 1490144.png (66.5 Kb)


auto-teacher

Сообщение отредактировал auto-teacher - Вторник, 26.09.2017, 20:24
 
Ответить
СообщениеЗдравствуйте!
Есть макрос (даже не макрос, а целый модуль), который вызывает диалоговое окно, а потом оно само гаснет. Можно задать время отображения.
Раньше модуль отлично работал, а тут стал выдавать ошибку. То ли из-за перехода с 32-битной системы на 64-битную, то ли еще от чего.
Может быть, таймер по-другому надо вызывать. Я слабоват в этом деле.
Подскажите, пожалуйста, что надо исправить.
Код модуля такой:
[vba]
Код

'To display a timed Msgbox use the MsgboxOKDrop routine given below.
'By Andrew Baker

Option Explicit

'API calls for Msgbox2. Must be placed in a standard module
Declare PtrSafe Function SetTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare PtrSafe Function KillTimer Lib "user32" (ByVal Hwnd As Long, ByVal nIDEvent As Long) As Long
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Private zsMessageTitle As String, lTimerId As Long

'Purpose     :  Stops the timer routine
'Inputs      :  N/A
'Outputs     :  Returns True if the timer routine was stopped
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:24
'Notes       :  Code must be placed in a module
'Revisions   :

Function EndTimer() As Boolean
    If lTimerId Then
        lTimerId = KillTimer(0&, lTimerId)
        lTimerId = 0
        EndTimer = True
    End If
End Function

'Purpose     :  Starts the continuous calling of a private routine at a specific time interval.
'Inputs      :  lInterval           The interval (in ms) at which to call the routine
'Outputs     :  N/A
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:30
'Notes       :  Code must be placed in a module
'Revisions   :

Sub StartTimer(lInterval As Long)
    If lTimerId Then
        'End Current Timer
        EndTimer
    End If
    lTimerId = SetTimer(0&, 0&, ByVal lInterval, AddressOf TimerRoutine)
End Sub

'Purpose     :  Routine which is called repeatedly by the timer API.
'Inputs      :  Inputs are automatically generated.
'Outputs     :
'Author      :  Andrew Baker
'Date        :  15/10/2000 15:32
'Notes       :
'Revisions   :

Private Sub TimerRoutine(ByVal lHwnd As Long, ByVal lMsg As Long, ByVal lIDEvent As Long, ByVal lTime As Long)
    Const WM_CLOSE = &H10
    Dim lHwndMsgbox As Long

    'Find the Msgbox
    lHwndMsgbox = FindWindow(vbNullString, zsMessageTitle)
    'Close Msgbox
    Call SendMessage(lHwndMsgbox, WM_CLOSE, 0, ByVal 0&)
End Sub

'Purpose     :  Extended version of Msgbox, has extra parameter to set time msgbox is displayed for
'Inputs      :  As per Msgbox
'               [DisplayTime]               The time in MS to display the message.
'Outputs     :  As per Msgbox
'Author      :  Andrew Baker
'Date        :  03/01/2001 13:23
'Notes       :
'Revisions   :

Function MsgboxOKDrop(Prompt As String, Buttons As VbMsgBoxStyle, Title As String, Optional DisplayTime As Long = 3000) As VbMsgBoxResult
    If DisplayTime > 0 Then
        'Enable the timer
        StartTimer DisplayTime
        zsMessageTitle = Title
    End If
    MsgboxOKDrop = MsgBox(Prompt, Buttons, Title)
    'Stop the timer
    EndTimer
End Function
[/vba]
Само сообщение вызывается таким кодом:
[vba]
Код

Sub СамогаснущееОкно()
    lRetVal = MsgboxOKDrop("Это окно должно само погаснуть!" & vbCrLf & "Сейчас, через 5 секунд, окно погаснет!", vbOKOnly + vbInformation, "Самогаснущее окно", 5000)
End Sub
[/vba]
При отладке ошибка выскакивает на строке выделенной желтым.
Фото прилагаются.

Автор - auto-teacher
Дата добавления - 26.09.2017 в 19:44
Pelena Дата: Вторник, 26.09.2017, 21:08 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 19184
Репутация: 4420 ±
Замечаний: ±

Excel 365 & Mac Excel
Здравствуйте.
из-за перехода с 32-битной системы на 64-битную

Попробуйте вместо As Long в описании аргументов функций использовать As LongPtr


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеЗдравствуйте.
из-за перехода с 32-битной системы на 64-битную

Попробуйте вместо As Long в описании аргументов функций использовать As LongPtr

Автор - Pelena
Дата добавления - 26.09.2017 в 21:08
al-Ex Дата: Среда, 27.09.2017, 01:09 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 190
Репутация: 59 ±
Замечаний: 0% ±

Excel 2010
вот примерно так объявить надо


Сообщение отредактировал al-Ex - Среда, 27.09.2017, 01:16
 
Ответить
Сообщениевот примерно так объявить надо

Автор - al-Ex
Дата добавления - 27.09.2017 в 01:09
auto-teacher Дата: Суббота, 30.09.2017, 12:11 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 20
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Спасибо за советы!
Я сделал по вашим указаниям так:
[vba]
Код
Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
[/vba]
И оно работает.
Ничего, что я Long так оставил? Ведь ошибки не выдает.


auto-teacher
 
Ответить
СообщениеСпасибо за советы!
Я сделал по вашим указаниям так:
[vba]
Код
Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
[/vba]
И оно работает.
Ничего, что я Long так оставил? Ведь ошибки не выдает.

Автор - auto-teacher
Дата добавления - 30.09.2017 в 12:11
al-Ex Дата: Суббота, 30.09.2017, 18:14 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 190
Репутация: 59 ±
Замечаний: 0% ±

Excel 2010


Сообщение отредактировал al-Ex - Суббота, 30.09.2017, 18:16
 
Ответить
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Самогаснущие диалоговые окна в Ворде (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!