Привязать справку CHM к форме UserForm

[Вождь]

Здравствуйте, товарищи

Оказывается, тема создания справки для VBA-проекта Word не раскрыта, тем более для современных версий

Как я понял, не получится использовать встроенные средства UserForm (WhatThisButton, WhatThisHelp, HelpContextID) вместе с созданной своими руками справкой в формате CHM. Или можно?

Остается вызывать справку программно, через HtmlHelpA. С простейшим вызовом разобрался, но хотелось бы организовать выдачу всплывающих подсказок и подсказок типа «что это?». Еще, интересуют макросы для доступа к элементам файла справки, например к текстам всплывающих подсказок.

Что есть на данный момент:

Option Explicit: Option Base 0: Option Compare Binary
#If VBA7 Then
    Private Declare PtrSafe Function HtmlHelp Lib "Hhctrl.ocx" Alias "HtmlHelpA" (ByVal hWndCaller As Long, ByVal pszFile As String, ByVal uCommand As Long, ByVal dwData As Long) As Long
#Else
    Private Declare Function HtmlHelp Lib "Hhctrl.ocx" Alias "HtmlHelpA" (ByVal hWndCaller As Long, ByVal pszFile As String, ByVal uCommand As Long, ByVal dwData As Long) As Long
#End If
Private Const HH_DISPLAY_TOPIC = &H0 ' вызов по имени раздела
Private Const HH_DISPLAY_TOC = &H1
Private Const HH_DISPLAY_INDEX = &H2
Private Const HH_DISPLAY_SEARCH = &H3
Private Const HH_SET_WIN_TYPE = &H4
Private Const HH_GET_WIN_TYPE = &H5
Private Const HH_GET_WIN_HANDLE = &H6
Private Const HH_GET_INFO_TYPES = &H7
Private Const HH_SET_INFO_TYPES = &H8
Private Const HH_SYNC = &H9
Private Const HH_ADD_NAV_UI = &HA
Private Const HH_ADD_BUTTON = &HB
Private Const HH_GETBROWSER_APP = &HC
Private Const HH_KEYWORD_LOOKUP = &HD
Private Const HH_DISPLAY_TEXT_POPUP = &HE
Private Const HH_HELP_CONTEXT = &HF ' вызов по Context ID
Private Function c_HelpFile() As String
    c_HelpFile = ThisDocument.Path & Application.PathSeparator & "Справка.chm"
End Function
Public Function HELP_Show() As Long ' вызов справки
    HELP_Show = HtmlHelp(0, c_HelpFile, HH_DISPLAY_TOPIC, 0)
End Function
Public Function HELP_Context(ByVal Context As Long, Optional ByVal WindowHandle As Long = 0) As Long
' вызов контекстной справки
    If Context <= 0 Then Exit Function
    HELP_Context = HtmlHelp(WindowHandle, c_HelpFile, HH_HELP_CONTEXT, Context)
End Function
Public Function HELP_PopUp(ByRef Form As MSForms.UserForm) As Long
' вызов всплывающей подсказки для активного элемента формы
' ??????????????????????????????????
End Function
Public Function HELP_WhatsThis (ByRef Form As MSForms.UserForm) As Long
' вызов подсказки «что это» для активного элемента формы
' ??????????????????????????????????
End Function

[Ципихович Эндрю]

ну Вашу тему надо раскачивать... вдруг мне что пригодится
то что есть и выложено как опробовать?
я бы ещё на http://www.sql.ru/ спросил

[Ципихович Эндрю]

ну Вашу тему надо раскачивать... вдруг мне что пригодится
то что есть и выложено как опробовать?
я бы ещё на http://www.sql.ru/ спросил

[Вождь]

Сообщение от Ципихович Эндрю

...то что есть и выложено как опробовать?...

Создаете справку в формате CHM (доки туча), и вперед...

Еще немного нарыл. Можно работать через shell:

Public Sub HELP_CMD_Open()  ' открыть файл справки
    Call Shell("cmd /cstart " & c_HelpFile)
End Sub

Public Sub HELP_Explorer_Open()  ' открыть файл справки
    Call Shell("explorer.exe " & c_HelpFile)
End Sub

' hh.exe

Public Sub HELP_HH_Open() ' открыть файл справки
    Call Shell("hh.exe " & c_HelpFile)
End Sub

Public Sub HELP_HH_Browser() ' открыть файл справки в браузере
    Call Shell("hh.exe -browser " & c_HelpFile)
End Sub

Public Sub HELP_HH_Context(ByVal ContextID As Long) ' вызов контекстной справки
    Call Shell("hh.exe -mapid " & CStr(ContextID) & " " & c_HelpFile)
End Sub

Public Sub HELP_HH_Address(ByVal Address As String) ' вызов справки по адресу
' Address - вход: имя страницы в формате: <файл>[#<якорь>]
' файл должен содержать путь, указанный при создании справки
    Call Shell("hh.exe " & c_HelpFile & "::/" & Address)
End Sub

[Вождь]

Да уж, с документацией по теме глухо, именно для Word Так и не разобрался, отчего не открывается справка, если chm-файл указать в свойствах VBA-проекта.

Сделал через хук клавиатуры, но решение мне не нравится, из-за нестабильности - пару раз аварийно закрывался Word. Собранный код прилагаю:

#If VBA7 And Win64 Then
    Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
        (ByVal idHook As LongLong, ByVal lpFn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongLong) As LongLong
    Declare PtrSafe Function CallNextHookEx Lib "user32" _
        (ByVal hHook As LongPtr, ByVal nCode As LongLong, ByVal wParam As LongLong, lParam As Any) As LongLong
    Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongLong
    Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongLong
    Dim myHook As LongLong
#Else
    Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
        (ByVal idHook As Long, ByVal lpFn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Declare Function CallNextHookEx Lib "user32" _
        (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
    Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Dim myHook As Long
#End If

' SetWindowsHookEx / idHook
Const WH_KEYBOARD% = &H2
Const WH_MOUSE% = &H7
' KeyboardProc / Code
Const HC_ACTION = 0
Const HC_NOREMOVE = 3
' KeyboardProc / wParam (Virtual-Key Codes)
Const VK_HELP = &H2F ' HELP key
Const VK_F1 = &H70 ' F1 key

' размещаем в модуле формы
'Sub UserForm_Initialize()
'    HELP_HookKeyboard_On
'End Sub
'Sub UserForm_Terminate()
'    HELP_HookKeyboard_Off
'End Sub

Public Sub HELP_HookKeyboard_On()
    myHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardProc, 0, GetCurrentThreadId)
End Sub

Public Sub HELP_HookKeyboard_Off()
    Call UnhookWindowsHookEx(hHook:=myHook)
End Sub
    
#If VBA7 And Win64 Then
Public Function KeyboardProc( _
        ByVal Code As LongLong, ByVal wParam As LongLong, lParam As LongLong) As LongLong
#Else
Public Function KeyboardProc( _
        ByVal Code As Long, ByVal wParam As Long, lParam As Long) As Long
#End If
' перехват событий клавиатуры
    If Code <> HC_ACTION Then
    'ElseIf (lParam And (2 ^ 30)) <> 0 Then ' 30й бит = до того: 0-отпущена, 1-нажата
    'ElseIf (lParam And (2 ^ 31)) = 0 Then ' 31й бит = сейчас: 0-отпущена, 1-нажата
    Else
        Select Case wParam
            Case VK_HELP, VK_F1: StatusBar = "F1"
        End Select
    End If
    KeyboardProc = CallNextHookEx(myHook, Code, wParam, ByVal lParam)
End Function