Create command buttons based on sheet names in UserForm1

[dinodeserter]

I am trying to figure out how to add command buttons based on sheet names in an excel workbook. I know I need to have something loop through the sheets and I figured out how to get the names with this snippet

Private Sub Getsheetnames()Dim ws As Worksheet
Dim wkbk As Workbook
Dim usfrm As UserForm1
Dim shtnames As String


Set wkbk = ThisWorkbook


For Each ws In Worksheets
shtnames = shtnames & ws.Name
Next
' Debug.Print


End Sub
I would like to place them inside a frame on UserForm1 so that they fill the frame and or resize it and the UserForm1 as needed. I think I know the code to get each command button to show the respective sheet it would be referring to but I might need help there also.
Any help would be great!!

[gmaxey]

Are you talking a handful of sheets (say less than a dozen) or hundreds?
If the former then it may be easier to just create a dozen or so statically with Visible set = False and then show only the ones actually present.


Private Sub UserForm_Initialize()
Dim lngIndex As Long
For lngIndex = 1 To ActiveWorkbook.Sheets.Count
Controls("CommandButton" & lngIndex).Visible = True
Controls("CommandButton" & lngIndex).Caption = ActiveWorkbook.Sheets(lngIndex).Name
Next
End Sub

[mikerickson]

I think it would be better to use a listbox rather than runtime command buttons, since that would take care of the coding, rather than having to use a Class module.


Private Sub UserForm_Initialize()
Dim oneSheet As Worksheet
With ListBox1
.Clear
For Each oneSheet In ThisWorkbook.Worksheets
.AddItem oneSheet.Name
If oneSheet.Name = ActiveSheet.Name Then .ListIndex = .ListCount - 1
Next oneSheet
End With
End Sub

Private Sub ListBox1_Click()
With ListBox1
If .ListIndex <> -1 Then
ThisWorkbook.Sheets(.Text).Activate
End If
End With
End Sub

But if you are set on using run-time command buttons, how do you want them arranged. e.g If you have 6 sheets, do you want them 3X2 or 2X3? Do you want the buttons to be sized to fill the frame or do you want them fixed sized and have scroll bars added to the frame if needed or do you want the frame to expand to fit? How do you plan to write the event code for these created Command Buttons.

As gmaxey said, if there are few enough sheets, you could use pre-existing command buttons. Or if there are a lot of sheets, the Listbox option is a good one.
I strongly advise against using run-time created controls for this purpose.

[mikerickson]

Just for the heck of it, I figured out a way to do this with added CommandButtons, but no Class module and not writing event code to the module at run-time.
I still think that using run-time controls is not the way to go. If you want the buttons arranged in some other way, the ArrangeControls routine will have to be altered.



' in userform code module

Public WithEvents CoverBox As MSForms.TextBox

Private Sub UserForm_Initialize()
Dim oneSheet As Worksheet

Frame1.Caption = vbNullString
Frame1.Width = 10: Frame1.Height = 10

Set CoverBox = Frame1.Controls.Add("forms.TextBox.1")
With CoverBox
.BackStyle = fmBackStyleTransparent
.MousePointer = fmMousePointerArrow
.SpecialEffect = fmSpecialEffectFlat
.Locked = True
End With

For Each oneSheet In ThisWorkbook.Worksheets
With Frame1.Controls.Add("forms.CommandButton.1")
.Height = 30
.Width = 70
.Font.Size = 11
.Caption = oneSheet.Name
If oneSheet.Name = ActiveSheet.Name Then
.Font.Bold = True: .Font.Underline = True
End If
End With
Next oneSheet

Call ArangeControls

End Sub

Private Sub CoverBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
Dim oneControl As MSForms.Control
For Each oneControl In Frame1.Controls
With oneControl
If .Name <> CoverBox.Name Then
If .Left < x And x < .Left + .Width Then
If .Top < y And y < .Top + .Height Then
ThisWorkbook.Sheets(oneControl.Caption).Activate
End If
End If
End If
End With
Next oneControl

For Each oneControl In Frame1.Controls
If TypeName(oneControl) = "CommandButton" Then
With oneControl
.Font.Bold = (.Caption = ActiveSheet.Name)
.Font.Underline = .Font.Bold
End With
End If
Next oneControl
End Sub

Sub ArangeControls()
Dim oneControl As MSForms.Control
Dim LVal As Single, TVal As Single
Dim i As Long
LVal = 0: TVal = 0
For Each oneControl In Frame1.Controls
If oneControl.Name <> CoverBox.Name Then
With oneControl
.Top = TVal
.Left = LVal
i = i + 1
LVal = LVal + .Width
If CoverBox.Width < LVal Then
Frame1.Width = Frame1.Width + (LVal - CoverBox.Width)
CoverBox.Width = Frame1.InsideWidth
End If
If CoverBox.Height < (TVal + .Height) Then
Frame1.Height = Frame1.Height + (TVal + .Height - CoverBox.Height)
CoverBox.Height = Frame1.InsideHeight
End If
If i Mod 3 = 0 Then
TVal = TVal + .Height
LVal = 0
End If
End With
End If
Next oneControl

CoverBox.ZOrder fmZOrderFront

End Sub

[Tom Jones]

Mike,

In button nr. 1 (Sheet1) in UserForm is a pulsing cursor. How can I do not to have that cursor.
Thank you .

[mikerickson]

The cursor not in button number 1, its in the text box CoverBox.
This is a more refined version. (CoverBox has been renamed tbxCover)

When the user clicks above one of the created command buttons, it becomes the ActiveButton and the ActiveButton_Click routine is run.
Actually, the user never clicks on the button, since the (transparent) tbxCover is covering all the buttons.
The user clicks on the text box, triggering the tbxCover_MouseDown event which figures out which button (if any) is below the place where the user clicked and acts accordingly.

All the machinery (highlighting the "clicked" button, reacting to Tab and Left buttons, etc.) is contained in the tbxCover_MouseDown, tbxCover_KeyDown and Frame1_Enter events. These can be left alone.

The ActiveButton_Click routine is where the coder should put their code. Note that ActiveButton.Caption is used more often than ActiveButton.Name, because sheets can have names that are illegal control names, so the names of the added command buttons are not specified.

This was an interesting exercise, writing code for run-time command buttons that doesn't use a Class Module, but its pretty much that, just an exercise.
If I were to do this "for real", I'd use a class module or, optimally, design a userform that did not need controls created at run-time.


' in userform code module

Dim ActiveButton As MSForms.CommandButton
Public WithEvents tbxCover As MSForms.TextBox

Private Sub ActiveButton_Click()
On Error Resume Next
ThisWorkbook.Sheets(ActiveButton.Caption).Activate
On Error GoTo 0
End Sub

Private Sub UserForm_Initialize()
Frame1.Caption = vbNullString: Rem can be set at design time

Call MakeCommandButtons
End Sub

Sub MakeCommandButtons()
Dim oneSheet As Worksheet
Dim i As Long

Rem create tbxCover
Set tbxCover = Frame1.Controls.Add("forms.TextBox.1")
With tbxCover
.BackStyle = fmBackStyleTransparent
.MousePointer = fmMousePointerArrow
.SpecialEffect = fmSpecialEffectFlat
.Text = vbNullString
.TextAlign = fmTextAlignRight
.Locked = True
.Top = 0: .Left = 0
End With

Rem create buttons at run-time
For Each oneSheet In ThisWorkbook.Worksheets
With Frame1.Controls.Add("forms.CommandButton.1")
.Height = 23
.Width = 67
.Font.Size = 11
.Caption = oneSheet.Name
End With
Next oneSheet
ArrangeControls
End Sub

Sub HighlightButtons(Optional WithCaption As String)
Dim oneControl As MSForms.Control

If (WithCaption = vbNullString) And (Not (ActiveButton Is Nothing)) Then
WithCaption = ActiveButton.Caption
End If

For Each oneControl In Frame1.Controls
If TypeName(oneControl) = "CommandButton" Then
With oneControl
.Font.Bold = (.Caption = WithCaption)
.Font.Underline = .Font.Bold
End With
End If
Next oneControl
End Sub

Sub ArrangeControls()
Dim oneControl As MSForms.Control
Dim LVal As Single, TVal As Single
Dim i As Long, ColCount As Long
ColCount = 3

Frame1.Width = 10: Frame1.Height = 10

For Each oneControl In Frame1.Controls
With oneControl
If .Name <> tbxCover.Name Then
.Left = LVal
.Top = TVal
LVal = LVal + .Width

If .Parent.Width < LVal Then .Parent.Width = LVal + (.Parent.Width - .Parent.InsideWidth)
If .Parent.Height < TVal + .Height Then .Parent.Height = TVal + .Height + (.Parent.Height - .Parent.InsideHeight)

i = i + 1
If (i Mod ColCount) = 0 Then
LVal = 0
TVal = TVal + .Height
End If
End If
End With
Next oneControl

With tbxCover
.Width = .Parent.Width + 50
.Height = .Parent.Height
.ZOrder fmZOrderFront
End With
HighlightButtons WithCaption:=ActiveSheet.Name
End Sub

Private Sub Frame1_Enter()
tbxCover.SetFocus
End Sub

Private Sub tbxCover_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = vbKeyTab Or KeyCode = vbKeyReturn Then
If Shift = 0 Then
tbxCover.TabIndex = Frame1.Controls.Count - 1
Else
tbxCover.TabIndex = 0
End If
End If
End Sub

Private Sub tbxCover_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
Dim oneControl As MSForms.Control
For Each oneControl In Frame1.Controls
With oneControl
If .Name <> tbxCover.Name Then
If .Left < x And x < .Left + .Width Then
If .Top < y And y < .Top + .Height Then
Set ActiveButton = oneControl
End If
End If
End If
End With
Next oneControl
If ActiveButton Is Nothing Then
Beep
Else
Call HighlightButtons
Call ActiveButton_Click
End If
End Sub

Private Sub CommandButton1_Click()
Unload Me
End Sub

[gmaxey]

Mike,

Interesting content. Thanks for posting!

[Tom Jones]

Thank you Mike.
Excellent job.