mileslowe
10-18-2007, 01:25 PM
I found some code on this forum under some archives.
I get an invalid call or procedure argument error when I click the created menu button and end up at the following line of code:
.insertlines X + 0, "Option Base 1"
I have Excel 2003 running in Windows XP. I seperated the code as requested with the link above into modules 4-5 for two of the areas suggesting using its own modules and ThisWorkbook for the code being suggested as placed here.
Here is the code: Place this code in ThisWorkbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Delete_Button
End Sub
Private Sub Workbook_Open()
Create_Button
End Sub
'Used to create a button to call the routine
'So it can be used in any workbook that is open.
The following code needs to be in another module (module4)
'This code handles the Back button, note
'it is robust enough to handle or use for
'any routine in which a return from is required.
Public Sub SaveLocation(ReturnToLoc As Boolean)
Static WB As Workbook
Static WS As Worksheet
Static Rg As Range
On Error GoTo NoGo
If ReturnToLoc = False Then
Set WB = ActiveWorkbook
Set WS = ActiveSheet
Set Rg = Selection
Else
WB.Activate
WS.Activate
Rg.Select
End If
Exit Sub
NoGo:
MsgBox "Not set !"
End Sub
'To save the current location, call SetSaveLoc.
Public Sub SetSaveLoc()
SaveLocation (False)
End Sub
'To return to the saved location, call GetSaveLoc.
Public Sub GetSaveLoc()
SaveLocation (True)
End Sub
Finally, this code needs to be placed in another module also: Module5
Option Base 1
'Passed back to the function from the UserForm
Public GETOPTION_RET_VAL As Variant
Function GetOption(Title)
Dim TempForm
Dim NewComboBox As MSForms.ComboBox
Dim NewCommandButton1 As MSForms.CommandButton
Dim NewCommandButton2 As MSForms.CommandButton
Dim NewCommandButton3 As MSForms.CommandButton
Dim X As Integer, TopPos As Integer
Dim MaxWidth As Long, Ams As String, Ap As String
Dim ShName()
' Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
' Create the UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 300
' Add the ComBoBox
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
Set NewComboBox = TempForm.Designer.Controls.Add("forms.combobox.1")
With NewComboBox
.MatchEntry = fmMatchEntryFirstLetter
.Width = 200
.Height = 15
.Left = 8
.Top = TopPos
If .Width > MaxWidth Then MaxWidth = .Width
End With
' Add the Cancel button
Set NewCommandButton1 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With
' Add the GO button
Set NewCommandButton2 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "GO"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With
' Add the Back button
Set NewCommandButton3 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton3
.Caption = "< Back"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 50
End With
Ap = Chr(34): Ams = Chr(38)
' Add event-hander subs for the CommandButtons
With TempForm.CodeModule
X = .CountOfLines
.insertlines X + 0, "Option Base 1"
.insertlines X + 1, "Sub CommandButton1_Click()"
.insertlines X + 2, " GETOPTION_RET_VAL=False"
.insertlines X + 3, " Unload Me"
.insertlines X + 4, "End Sub"
.insertlines X + 5, "Sub CommandButton2_Click()"
.insertlines X + 6, " SetSaveloc"
.insertlines X + 7, " On Error Resume Next"
.insertlines X + 8, " Sheets(ComboBox1.Text).Activate"
.insertlines X + 9, " If Err.Number <> 0 Then MsgBox " & _
Ap & "Sheet " & Ap & Ams & " ComboBox1.Text " & Ams & Ap & " doesn't exists!"
.insertlines X + 10, "End Sub"
.insertlines X + 11, "Private Sub UserForm_Initialize()"
.insertlines X + 12, "Dim ShName(),X as Integer"
.insertlines X + 13, "ReDim ShName(Sheets.Count)"
.insertlines X + 14, "For X = 1 To Sheets.Count"
.insertlines X + 15, " ShName(X) = Sheets(X).Name"
.insertlines X + 16, "Next"
.insertlines X + 17, "ComboBox1.List() = ShName()"
.insertlines X + 18, "SetSaveLoc"
.insertlines X + 19, "End Sub"
.insertlines X + 20, "Sub CommandButton3_Click()"
.insertlines X + 21, "GetSaveLoc"
.insertlines X + 22, "End Sub"
End With
' Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = 24 * 4 'no buttons + 1
End With
' Show the form
VBA.UserForms.Add(TempForm.Name).Show
' Delete the form
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm
' Pass the selected option back to the calling procedure
GetOption = GETOPTION_RET_VAL
End Function
Sub GotoSheet()
Dim UserChoice As Variant
UserChoice = GetOption("Select a Sheet")
If UserChoice = False Then End
End Sub
Sub Create_Button()
Dim TopButton As CommandBarButton
Set TopButton = Application.CommandBars(1).Controls.Add(Type:=msoControlButton, _
Before:=10)
With TopButton
.Style = msoButtonCaption
.Caption = "GoTo Sheet"
.OnAction = "GotoSheet"
End With
End Sub
Sub Delete_Button()
Application.CommandBars(1).Controls("GoTo Sheet").Delete
End Sub
I close the spreadsheet and save, then open it and alas, the new menu called goto.. appears and I click on that and end up with the error mentioned at the top of this post. Any suggestions would be helpful!
Any help would be greatly appreciated!
I get an invalid call or procedure argument error when I click the created menu button and end up at the following line of code:
.insertlines X + 0, "Option Base 1"
I have Excel 2003 running in Windows XP. I seperated the code as requested with the link above into modules 4-5 for two of the areas suggesting using its own modules and ThisWorkbook for the code being suggested as placed here.
Here is the code: Place this code in ThisWorkbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Delete_Button
End Sub
Private Sub Workbook_Open()
Create_Button
End Sub
'Used to create a button to call the routine
'So it can be used in any workbook that is open.
The following code needs to be in another module (module4)
'This code handles the Back button, note
'it is robust enough to handle or use for
'any routine in which a return from is required.
Public Sub SaveLocation(ReturnToLoc As Boolean)
Static WB As Workbook
Static WS As Worksheet
Static Rg As Range
On Error GoTo NoGo
If ReturnToLoc = False Then
Set WB = ActiveWorkbook
Set WS = ActiveSheet
Set Rg = Selection
Else
WB.Activate
WS.Activate
Rg.Select
End If
Exit Sub
NoGo:
MsgBox "Not set !"
End Sub
'To save the current location, call SetSaveLoc.
Public Sub SetSaveLoc()
SaveLocation (False)
End Sub
'To return to the saved location, call GetSaveLoc.
Public Sub GetSaveLoc()
SaveLocation (True)
End Sub
Finally, this code needs to be placed in another module also: Module5
Option Base 1
'Passed back to the function from the UserForm
Public GETOPTION_RET_VAL As Variant
Function GetOption(Title)
Dim TempForm
Dim NewComboBox As MSForms.ComboBox
Dim NewCommandButton1 As MSForms.CommandButton
Dim NewCommandButton2 As MSForms.CommandButton
Dim NewCommandButton3 As MSForms.CommandButton
Dim X As Integer, TopPos As Integer
Dim MaxWidth As Long, Ams As String, Ap As String
Dim ShName()
' Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
' Create the UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 300
' Add the ComBoBox
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
Set NewComboBox = TempForm.Designer.Controls.Add("forms.combobox.1")
With NewComboBox
.MatchEntry = fmMatchEntryFirstLetter
.Width = 200
.Height = 15
.Left = 8
.Top = TopPos
If .Width > MaxWidth Then MaxWidth = .Width
End With
' Add the Cancel button
Set NewCommandButton1 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With
' Add the GO button
Set NewCommandButton2 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "GO"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With
' Add the Back button
Set NewCommandButton3 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton3
.Caption = "< Back"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 50
End With
Ap = Chr(34): Ams = Chr(38)
' Add event-hander subs for the CommandButtons
With TempForm.CodeModule
X = .CountOfLines
.insertlines X + 0, "Option Base 1"
.insertlines X + 1, "Sub CommandButton1_Click()"
.insertlines X + 2, " GETOPTION_RET_VAL=False"
.insertlines X + 3, " Unload Me"
.insertlines X + 4, "End Sub"
.insertlines X + 5, "Sub CommandButton2_Click()"
.insertlines X + 6, " SetSaveloc"
.insertlines X + 7, " On Error Resume Next"
.insertlines X + 8, " Sheets(ComboBox1.Text).Activate"
.insertlines X + 9, " If Err.Number <> 0 Then MsgBox " & _
Ap & "Sheet " & Ap & Ams & " ComboBox1.Text " & Ams & Ap & " doesn't exists!"
.insertlines X + 10, "End Sub"
.insertlines X + 11, "Private Sub UserForm_Initialize()"
.insertlines X + 12, "Dim ShName(),X as Integer"
.insertlines X + 13, "ReDim ShName(Sheets.Count)"
.insertlines X + 14, "For X = 1 To Sheets.Count"
.insertlines X + 15, " ShName(X) = Sheets(X).Name"
.insertlines X + 16, "Next"
.insertlines X + 17, "ComboBox1.List() = ShName()"
.insertlines X + 18, "SetSaveLoc"
.insertlines X + 19, "End Sub"
.insertlines X + 20, "Sub CommandButton3_Click()"
.insertlines X + 21, "GetSaveLoc"
.insertlines X + 22, "End Sub"
End With
' Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left + NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = 24 * 4 'no buttons + 1
End With
' Show the form
VBA.UserForms.Add(TempForm.Name).Show
' Delete the form
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm
' Pass the selected option back to the calling procedure
GetOption = GETOPTION_RET_VAL
End Function
Sub GotoSheet()
Dim UserChoice As Variant
UserChoice = GetOption("Select a Sheet")
If UserChoice = False Then End
End Sub
Sub Create_Button()
Dim TopButton As CommandBarButton
Set TopButton = Application.CommandBars(1).Controls.Add(Type:=msoControlButton, _
Before:=10)
With TopButton
.Style = msoButtonCaption
.Caption = "GoTo Sheet"
.OnAction = "GotoSheet"
End With
End Sub
Sub Delete_Button()
Application.CommandBars(1).Controls("GoTo Sheet").Delete
End Sub
I close the spreadsheet and save, then open it and alas, the new menu called goto.. appears and I click on that and end up with the error mentioned at the top of this post. Any suggestions would be helpful!
Any help would be greatly appreciated!