На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! Организуем VBA-FAQ! Если у Вас есть предложения, выскажитесь здесь: Пишем FAQ, интересно Ваше мнение
Популярные разделы FAQ:    user posted image Общие вопросы    user posted image Особенности VBA-кода    user posted image Оптимизация VBA-кода    user posted image Полезные ссылки

1. Старайтесь при создании темы указывать в заголовке или теле сообщения название офисного приложения и (желательно при работе с Office 95/97/2000) его версию. Это значительно сократит количество промежуточных вопросов.
2. Формулируйте вопросы как можно конкретнее, вспоминая (хотя бы иногда) о правилах ВЕЛИКОГО И МОГУЧЕГО РУССКОГО ЯЗЫКА, и не забывая, что краткость - сестра таланта.
3. Не забывайте использовать теги [сode=vba] ...текст программы... [/code] для выделения текста программы подсветкой!
4. Темы с просьбой выполнить какую-либо работу полностью за автора здесь не обсуждаются и переносятся в раздел ПОМОЩЬ СТУДЕНТАМ.
Модераторы: Old Bat, MIF
  
> Самогаснущие окна в Word 2013 , Ошибка в макрокоманде, вызывающей диалоговое окно, которое само должно погаснуть.
    Здравствуйте!
    Есть макрос (даже не макрос, а целый модуль), который вызывает диалоговое окно, а потом оно само гаснет. Можно задать время отображения.
    Раньше модуль отлично работал, а тут стал выдавать ошибку. То ли из-за перехода с 32-битной системы на 64-битную, то ли еще от чего.
    Может быть, таймер по-другому надо вызывать. Я слабоват в этом деле.
    Подскажите, пожалуйста, что надо исправить.
    Код модуля такой:
    ExpandedWrap disabled
      '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

    Само сообщение вызывается таким кодом:
    ExpandedWrap disabled
      Sub СамогаснущееОкно()
          lRetVal = MsgboxOKDrop("Это окно должно само погаснуть!" & vbCrLf & "Сейчас, через 5 секунд, окно погаснет!", vbOKOnly + vbInformation, "Самогаснущее окно", 5000)
      End Sub

    При отладке ошибка выскакивает на строке выделенной желтым.
    Фото прилагаются.
    Прикреплённый файлПрикреплённый файл__________________________1.png (15,45 Кбайт, скачиваний: 637)
    Прикреплённый файлПрикреплённый файл__________________________2.png (10,17 Кбайт, скачиваний: 633)
      Цитата auto-teacher @
      То ли из-за перехода с 32-битной системы на 64-битную, то ли еще от чего.

      Видимо - да, т.к. в SetTimer параметры Hwnd и lpTimerFunc объявлены As Long, который является 32-битным независимо от разрядности Word-а. Для совместимости 32- и 64-битных версий нужно все хэндлы и указатели в АПИ-функциях объявлять не как Long, а как LongPtr
      0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
      0 пользователей:


      Рейтинг@Mail.ru
      [ Script execution time: 0,0212 ]   [ 18 queries used ]   [ Generated: 16.04.24, 06:12 GMT ]