Hello I have a challenge and cant solve it, i have excel vba where i have a UserFrom1. In this UserForm1 is a button, as soon as I click the button UserForm2 opens, there are 2 TextBoxes and a button. In Textbox1 I enter and the values are in column A2 to A…. the same is also saved for texbox2 the values are then saved in B2 to B…. (of course they are saved as soon as I click the button in UserForm2.
Now I have a code that does the following. It takes the values from A2 to A…. and automatically creates buttons in UserForm1 with the names in A2 to A…. so if, for example, A2 contains “App”, then a button called “App” is automatically generated in UserForm1. And that up to infinity how many entries I then also have in column A. The code is written below.
I want to make things a little more complicated and have been working on it for a few days but have not found a solution. I always enter links in column B which lead to Windwos Order e.g. C:\User\App, this link should open when I click the button “App”. the same applies to A3, if there is “System” and in B3 C:\User\System the generated button with name “System” in UserForm1 should open the link with C:\User\System. Hope it was understandable so far.
Here is my code for automatic button generation.
Sub UserForm1_Initialize()
With UserForm1
' last for A find
Dim lastRowA As Long
lastRowA = ThisWorkbook.Sheets(1).Cells(ThisWorkbook.Sheets(1).Rows.Count, 1).End(xlUp).Row
' reverse
Dim i As Long
For i = .Controls.Count - 1 To 0 Step -1
If TypeName(.Controls(i)) = "CommandButton" Then
If Left(.Controls(i).Name, 7) = "Button_" Then
.Controls.Remove i
End If
End If
Next i
Dim topOffset As Integer
topOffset = 10 ' Start position
For i = 2 To lastRowA
' Creating button
Dim newButton As MSForms.CommandButton
Set newButton = .Controls.Add("Forms.CommandButton.1", "Button_" & i - 1, True)
' Creating Button
With newButton
.Caption = ThisWorkbook.Sheets(1).Cells(i, 1).Value
.Left = 10
.Top = topOffset
.Width = 120
.Height = 20
End With
' Position
topOffset = topOffset + 30 ' area Between buttons
Next i
End With
End Sub
After some additions on code here my whole code:
UserForm1:
Private Sub CommandButton1_Click()
UserForm1.Hide
UserForm2.Show
End Sub
Private Sub SaveClose_Click()
UserForm1.Hide
UserForm3.Show
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Application.Visible = True
End Sub
Private Sub EditMode_Click()
Application.Visible = True
ThisWorkbook.Windows(1).Visible = True
ThisWorkbook.Sheets(1).Activate
Me.Hide
End Sub
Private Sub UserForm_Terminate()
UserForm1.Hide
End Sub
UserForm2:
Private Sub Liste_Click()
UserForm2.Hide
UserForm1.Show
End Sub
Private Sub SaveList_Click()
' Daten aus den Textboxen holen
Dim value1 As String
Dim value2 As String
value1 = UserForm2.TextBoxName.Value
value2 = UserForm2.TextBoxLink.Value
' Daten in Tabelle schreiben
With ThisWorkbook.Sheets(1)
' Letzte Zeile finden
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
' Daten in die Zellen schreiben
.Cells(lastRow, 1).Value = value1
.Cells(lastRow, 2).Value = value2
End With
' Excel-Datei speichern
ThisWorkbook.Save
' UserForm1 neu initialisieren (Buttons erstellen)
UserForm1_Initialize
End Sub
Private Sub SaveClose_Click()
UserForm2.Hide
UserForm3.Show
End Sub
Private Sub UserForm_Terminate()
ThisWorkbook.Save
ThisWorkbook.Close
End Sub
Private Sub EditMode_Click()
Application.Visible = True
ThisWorkbook.Windows(1).Visible = True
ThisWorkbook.Sheets(1).Activate
Me.Hide
End Sub
Module1:
Option Explicit
Dim cmdArray() As New Klasse1
Sub showLoginForm()
If isSheetVisible Then
' Only Hide this workbook and keep the other workbooks visible
ThisWorkbook.Windows(1).Visible = False
Else
' There is no other workbook visible, hide Excel
Application.Visible = False
End If
UserForm1.Show
End Sub
Function isSheetVisible() As Boolean
' Checks if any workbook except the current one is visible
Dim wb As Workbook
For Each wb In Application.Workbooks
If Not wb Is ThisWorkbook Then
Dim win As Window
For Each win In wb.Windows
If win.Visible Then isSheetVisible = True
Next
End If
Next
End Function
Sub UserForm1_Initialize()
With UserForm1
' last for A find
Dim lastRowA As Long
lastRowA = ThisWorkbook.Sheets(1).Cells(ThisWorkbook.Sheets(1).Rows.Count, 1).End(xlUp).Row
ReDim conts(1 To lastRowA - 1) As Klasse1 'array for the classes
' reverse
Dim i As Long
For i = .Controls.Count - 1 To 0 Step -1
If TypeName(.Controls(i)) = "CommandButton" Then
If Left(.Controls(i).Name, 7) = "Button_" Then
.Controls.Remove i
End If
End If
Next i
Dim topOffset As Integer
topOffset = 10 ' Start position
For i = 2 To lastRowA
' Creating button
Dim newButton As MSForms.CommandButton
Set newButton = .Controls.Add("Forms.CommandButton.1", "Button_" & i - 1, True)
' Creating Button
With newButton
.Caption = ThisWorkbook.Sheets(1).Cells(i, 1).Value
.Left = 10
.Top = topOffset
.Width = 120
.Height = 20
.Tag = ThisWorkbook.Sheets(1).Range("B1").Value
End With
ReDim Preserve cmdArray(1 To i)
Set cmdArray(i).CmdEvents = newButton
Set newButton = Nothing
' Position
topOffset = topOffset + 30 ' area Between buttons
Next i
End With
End Sub
Class1:
Option Explicit
Public WithEvents CmdEvents As MSForms.CommandButton
Private Sub CmdEvents_Click()
Shell "explorer.exe" & " " & CmdEvents.Tag, vbNormalFocus
End Sub
You can use the .Tag
property to store the path. BTW intellisense will not give you access to property but trust me it works (Demonstration below). Here is an example.
Let’s say we have 2 userforms. UserForm1
and UserForm2
Paste this code in the Userform1
Option Explicit
Private Sub CommandButton1_Click()
Dim frm As New UserForm2
With frm
Dim newButton As MSForms.CommandButton
Set newButton = .Controls.Add("Forms.CommandButton.1", "ButtonA", True)
' Creating Button
With newButton
.Caption = ThisWorkbook.Sheets(1).Range("A1").Value
.Left = 10
.Top = 10
.Width = 120
.Height = 20
'~~> This is where you store the path
.Tag = ThisWorkbook.Sheets(1).Range("B1").Value
End With
.Show
End With
End Sub
And to launch the path, simply use Shell
Shell "explorer.exe" & " " & Btn.Tag, vbNormalFocus
Also please see Assign code to a button created dynamically on how to assign code to a button created dynamically. Use the above Shell
command in the class module.
Demonstration
Let’s say my worksheet looks like this
Let’s say my Userform1
looks like this
Let’s say my Userform2
looks like this
Code in Userform1
Option Explicit
Dim cmdArray() As New Class1
Private Sub CommandButton1_Click()
Dim frm As New UserForm2
Dim i As Long: i = 1
With frm
Dim newButton As MSForms.CommandButton
Set newButton = .Controls.Add("Forms.CommandButton.1", "ButtonA", True)
' Creating Button
With newButton
.Caption = ThisWorkbook.Sheets(1).Range("A1").Value
.Left = 10
.Top = 10
.Width = 120
.Height = 20
'~~> This is where you store the path
.Tag = ThisWorkbook.Sheets(1).Range("B1").Value
End With
ReDim Preserve cmdArray(1 To i)
Set cmdArray(i).CmdEvents = newButton
Set newButton = Nothing
.Show
End With
End Sub
Code in Class Module Class1
Option Explicit
Public WithEvents CmdEvents As MSForms.CommandButton
Private Sub CmdEvents_Click()
Shell "explorer.exe" & " " & CmdEvents.Tag, vbNormalFocus
End Sub
In Action
You need to catch the click event of the generated CommandButtons. For this create a class module named Class1
with this code, where Sheets(1) is the same sheet as in yours.
Public WithEvents contbutts As MSForms.CommandButton
Private Sub contbutts_click()
clicked_no = Mid(contbutts.Caption, 8)
Sheets(1).Cells(clicked_no + 1, 2).Hyperlinks(1).Follow
End Sub
Insert the assignment into your code
Sub UserForm1_Initialize()
With UserForm1
' last for A find
Dim lastRowA As Long
lastRowA = ThisWorkbook.Sheets(1).Cells(ThisWorkbook.Sheets(1).Rows.Count, 1).End(xlUp).Row
ReDim conts(1 To lastRowA - 1) As Class1 'array for the classes
' reverse
Dim i As Long
For i = .Controls.Count - 1 To 0 Step -1
If TypeName(.Controls(i)) = "CommandButton" Then
If Left(.Controls(i).Name, 7) = "Button_" Then
.Controls.Remove i
End If
End If
Next i
Dim topOffset As Integer
topOffset = 10 ' Start position
For i = 2 To lastRowA
' Creating button
Dim newButton As MSForms.CommandButton
Set newButton = .Controls.Add("Forms.CommandButton.1", "Button_" & i - 1, True)
' Creating Button
With newButton
.Caption = ThisWorkbook.Sheets(1).Cells(i, 1).Value
.Left = 10
.Top = topOffset
.Width = 120
.Height = 20
End With
Set conts(i - 1) = New Class1 'create a class for the button
Set conts(i - 1).contbutts = newButton 'assign the button to the class's button to catch the click event.
' Position
topOffset = topOffset + 30 ' area Between buttons
Next i
End With
UserForm1.Show
End Sub
On your sheet when you add the button name in col.A immediately create a link to anywhere (e.g. folder) in col.B Then there is no need of second userform and anything else.
This is the sheets(1) content:
.Tag = ThisWorkbook.Sheets(1).Cells(i, "B").Value
.worked. Thanks. Now its running