' This procedure is used by the Show Me button on various Developer
' Solutions toolbars. It uses the WinHelp API function so that the
' Show Me Help button will provide context-sensitive Help regardless
' of the current state of the object. Make sure that the Help file is
' in the same directory as the Developer Solutions database.
Dim lnghWnd As Long, strHelpFile As String, lngContext As Long
Dim lngRetVal As Long, obj As Object
On Error Resume Next
Const conHelpContext = &H1
Set obj = Screen.ActiveForm
If Err = 2475 Then
' Active object is not a form.
' Reset Err and test for Report object.
Err = 0
Set obj = Screen.ActiveReport
If Err = 2476 Then
' Current object is not a form or a report.
MsgBox "Select a form or report before you ask for help."
ShowHelpAPI = False
Exit Function
End If
End If
With obj
' Get the current object's hWnd, HelpFile, and HelpContextID properties.
lnghWnd = .hWnd
strHelpFile = .HelpFile
lngContext = .HelpContextId
End With
lngRetVal = WinHelp(lnghWnd, strHelpFile, conHelpContext, lngContext)
ShowHelpAPI = True
End Function
作者: zhuyiwen 时间: 2002-6-23 08:56
Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal Hwnd As Long, _
ByVal lpHelpFile As String, ByVal wCommand As Long, _
ByVal dwData As Any)
Function ShowHelpAPI() As Boolean
' This procedure is used by the Show Me button on various Developer
' Solutions toolbars. It uses the WinHelp API function so that the
' Show Me Help button will provide context-sensitive Help regardless
' of the current state of the object. Make sure that the Help file is
' in the same directory as the Developer Solutions database.
Dim lnghWnd As Long, strHelpFile As String, lngContext As Long
Dim lngRetVal As Long, obj As Object
On Error Resume Next
Const conHelpContext = &H1
Set obj = Screen.ActiveForm
If Err = 2475 Then
' Active object is not a form.
' Reset Err and test for Report object.
Err = 0
Set obj = Screen.ActiveReport
If Err = 2476 Then
' Current object is not a form or a report.
MsgBox "Select a form or report before you ask for help."
ShowHelpAPI = False
Exit Function
End If
End If
With obj
' Get the current object's hWnd, HelpFile, and HelpContextID properties.
lnghWnd = .hWnd
strHelpFile = .HelpFile
lngContext = .HelpContextId
End With
lngRetVal = WinHelp(lnghWnd, strHelpFile, conHelpContext, lngContext)
ShowHelpAPI = True
End Function
这是开发版代码库中的范例，使用.HLP。作者: zhuyiwen 时间: 2002-6-23 08:57
TMTONY比我快！作者: tmtony 时间: 2002-6-23 09:04
没你的提示，我一时还找不到：）， 再说， 你的正确些啦，我还没加定义啦作者: zhuyiwen 时间: 2002-6-23 09:10
Sub AddHelpMenu()
Dim cbrBar As CommandBar
Dim ctlCBarControl As CommandBarControl
' Set a reference to the Help menu.
Set cbrBar = CommandBars!Help
' If the My Help command already exists, delete it.
For Each ctlCBarControl In cbrBar.Controls
If ctlCBarControl.Caption = "&My Help" Then
cbrBar.Controls("My Help").Delete
End If
Next
' Create a new CommandBarControl object on the Help menu
' and add a reference to it.
Set ctlCBarControl = cbrBar.Controls.Add(Type:=msoControlButton)
' Set properties of the new command to display context-sensitive
' pop-up help. Set OnAction to call DisplayHelp procedure to display
' a help topic when clicked.
With ctlCBarControl
.Caption = "&My Help"
.BeginGroup = True
.FaceId = 0
.OnAction = "DisplayHelpXL"
.HelpFile = "sample.chm"
.HelpContextID = 1000
.Visible = True
End With
End Sub
或
Sub DisplayHelpXL()
Application.Help Currentproject.Path & "\sample.chm", 2001
End Sub作者: zhuyiwen 时间: 2002-6-23 09:14
Declare Function HtmlHelp Lib "hhctrl.ocx" Alias "HtmlHelpA" _
(ByVal hwndCaller As Long, _
ByVal pszFile As String, _
ByVal uCommand As HH_COMMAND, _
dwData As Any) As Long