Search code examples
excelvba

Excel vba open windows folder with button


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:

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:

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

Solution

  • 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:

    enter image description here