Create on the fly goto sheet form

[mileslowe]

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!

[lucas]

Adding controls on the fly is complicated and generally avoided by the best of programmers. Why is it necessary in your application?

[Bob Phillips]

That line should go at the start of the module, so try

[vba]

.insertlines 1, "Option Base 1"
[/vba]

[mikerickson]

My experience with creating and deleting controls is that deleting does not completely free up the memory. This results in the file getting larger each time that a control is created and destroyed.
I would recommend setting the control's .Visible property to True or False as needed.

[mileslowe]

The suggestion provided by Mike partially worked, but not sure I understood what was meant by putting it at the front of the module or by putting it before the code shown here, which may be causing me some real issues with the error I talk about at the end of this post. Mike, would you be willing to post a little of the code or enough for me to see where you thought it should be? Changing the controls to visable or setting it to true and then false sounds like a better idea from what your saying. I will have to take another look at the code here to accomplish that task. I have done some coding but not a lot. Lucas, I would never want to code this say, but with my limited VBA knowledge, it was hard to do a form and add that to the menu bar and found this code from another source and the options like the back button and goto sheets seemed to fit. My only need is the following: 1) Have a sheet list where when it is clicked on, I would go there and 2) return to the previous sheet in a similar maner. Mike, here is the code modified from the org set per what I thought you were saying - see last few lines of this code - thanks:

[VBA]

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 1, "Option Base 1"

[/VBA]

After running the code as modified above, everything works until you select the back button and you get an error telling you that you cannnot add comments after the end of the last sub. There are two forms 7 and 8 created where the code looks like this:

[VBA]

Sub CommandButton3_Click()
GetSaveLoc
End Sub
Option Base 1

[/VBA]

[lucas]

Here is an example where the only thing created on the fly is the menu button which is deleted when the workbook is closed.

originally from XL-Logic.com

there are many ways to do this without creating buttons, etc on the fly.

[lucas]

Here is another method. You don't have to manually add sheets to this one just add a new sheet and it appears in the menu...by Zack I think.

[lucas]

another that add sheets to the list automatically.....look for "my menu" after help on the main menu

of these with menu items you will notice that the only thing added on the fly is the menu's and they are deleted when the workbook closes...

[mileslowe]

I see my post count is zero and can't see the attachments - will have to try and correct that in order to see the attachments. That menu button has grown since adding the one line suggested by Mike and seems to now be a part of other opened spread sheets and causing issues, which I need to try and resolve first. Thanks for the reply and attachments and will try to get back to this after some clean up work is done.

[mileslowe]

I now was able to download the attachments and will look at them - thanks so much for sharing them! Now to try and undo the issues from the on the fly code submitted here.

[lucas]

I'm just trying to point out that you will probably run into a lot of "issues" by adding controls on the fly and there are easier and cleaner methods of doing what you desire.....

post a couple of one line posts to get your post count up if you need to.