D
donh
Hi,
I am working on some "Flash" based help files which run in Internet
Explorer. The help files are for users of a worksheet I finished just
before Christmas. I have looked through old files which an ex
colleague worked on and have cobbled together some VBA. It works but I
forgot in my thinking that I 'm not wanting to open a spreadsheet I
wont to open a web browser.
I can see places in the code that are wrong but do not have the skill
to know what these parts should be replaced with.
As an aside the link address below comes from a cell refrence. I've
done this so users can update the location of the help file without
having to open up and find their way around VBA.
As always any help would be most appreciated, I'm not going to be able
to work this out without you.
DonH
Sub AddMenuItem()
Dim HelpMenu As CommandBarPopup
Dim NewMenuItem As CommandBarButton
Set HelpMenu = CommandBars(1).FindControl(ID:=30010)
If HelpMenu Is Nothing Then
MsgBox "Cannot add Flexi Help to menu! Help menu not present"
Exit Sub
Else
Set NewMenuItem = HelpMenu.Controls.Add _
(Type:=msoControlButton)
With NewMenuItem
.Caption = "Flexi Help"
.FaceId = 348
.OnAction = "HelpLink"
.BeginGroup = True
End With
End If
End Sub
Sub HelpLink()
On Error Resume Next
Dim stFullName As String
Dim stFileName As String
Dim Wkb As Workbook
stFullName = Sheets("Sheet1").Range("A2")
stFileName = GetFileName(stFullName)
If IsWorkbookOpen(stFileName) Then
Set Wkb = Workbooks(stFileName)
Wkb.Activate
Else
Set Wkb = Workbooks.Open(Filename:=stFullName)
End If
End Sub
Function GetFileName(stFullName As String) As String
Dim stPathSep As String
Dim iFNLength As Integer
Dim i As Integer
stPathSep = Application.PathSeparator
iFNLength = Len(stFullName)
For i = iFNLength To 1 Step -1
If Mid(stFullName, i, 1) = stPathSep Then Exit For
Next i
GetFileName = Right(stFullName, iFNLength - i)
End Function
Private Function IsWorkbookOpen(stName As String) As Boolean
'Returns TRUE if the workbook is open
Dim Wkb As Workbook
On Error Resume Next
Set Wkb = Workbooks(stName)
If Not Wkb Is Nothing Then
IsWorkbookOpen = True
End If
End Function
I am working on some "Flash" based help files which run in Internet
Explorer. The help files are for users of a worksheet I finished just
before Christmas. I have looked through old files which an ex
colleague worked on and have cobbled together some VBA. It works but I
forgot in my thinking that I 'm not wanting to open a spreadsheet I
wont to open a web browser.
I can see places in the code that are wrong but do not have the skill
to know what these parts should be replaced with.
As an aside the link address below comes from a cell refrence. I've
done this so users can update the location of the help file without
having to open up and find their way around VBA.
As always any help would be most appreciated, I'm not going to be able
to work this out without you.
DonH
Sub AddMenuItem()
Dim HelpMenu As CommandBarPopup
Dim NewMenuItem As CommandBarButton
Set HelpMenu = CommandBars(1).FindControl(ID:=30010)
If HelpMenu Is Nothing Then
MsgBox "Cannot add Flexi Help to menu! Help menu not present"
Exit Sub
Else
Set NewMenuItem = HelpMenu.Controls.Add _
(Type:=msoControlButton)
With NewMenuItem
.Caption = "Flexi Help"
.FaceId = 348
.OnAction = "HelpLink"
.BeginGroup = True
End With
End If
End Sub
Sub HelpLink()
On Error Resume Next
Dim stFullName As String
Dim stFileName As String
Dim Wkb As Workbook
stFullName = Sheets("Sheet1").Range("A2")
stFileName = GetFileName(stFullName)
If IsWorkbookOpen(stFileName) Then
Set Wkb = Workbooks(stFileName)
Wkb.Activate
Else
Set Wkb = Workbooks.Open(Filename:=stFullName)
End If
End Sub
Function GetFileName(stFullName As String) As String
Dim stPathSep As String
Dim iFNLength As Integer
Dim i As Integer
stPathSep = Application.PathSeparator
iFNLength = Len(stFullName)
For i = iFNLength To 1 Step -1
If Mid(stFullName, i, 1) = stPathSep Then Exit For
Next i
GetFileName = Right(stFullName, iFNLength - i)
End Function
Private Function IsWorkbookOpen(stName As String) As Boolean
'Returns TRUE if the workbook is open
Dim Wkb As Workbook
On Error Resume Next
Set Wkb = Workbooks(stName)
If Not Wkb Is Nothing Then
IsWorkbookOpen = True
End If
End Function