Index Sheets with Shapes and Hyperlink

**TomyLee** · 09-03-2012, 07:48 PM

Hello,

What code would I have to create buttons or links (depending on 2 option buttons in userform) for sheets in the file.
As an option want to write the name of new sheets in a textbox.

Can you help me to start or show me how I can makeit?

Thank you.

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNsaS3Lp1
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgR1EPUkhw
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

**Admin** · 09-03-2012, 08:41 PM

Hi TomyLee,

Welcome to ExcelFox !!!

Could you please elaborate little more ? Perhaps attach the workbook ?

**TomyLee** · 09-03-2012, 10:53 PM

Hello Admin,

How can attach the workbook?

In my userForm i have 2 option button (one to create hyperlinks to all my sheets, and second to create buttons with link to all my sheets). A textBox where I can write name of new sheet where will be all name of sheets - with hyperlink or buttons with name of sheet.
Also have a comboBox where I choose number of columns for list (with name of sheet) or for buttons (with name of sheet).

**TomyLee** · 09-03-2012, 11:38 PM

In my userForm i have 2 option button (one to create hyperlinks to all my sheets, and second to create buttons with link to all my sheets). A textBox where I can write name of new sheet where will be all name of sheets - with hyperlink or buttons with name of sheet.
Also have a comboBox where I choose number of columns for list (with name of sheet) or for buttons (with name of sheet).

**Admin** · 09-04-2012, 08:53 AM

Hi

If you click on Go Advanced, you could see 'manage attachments'. Click on the button and upload the file.

**Admin** · 09-04-2012, 04:02 PM

Hi

Put this code in the userform module.

Code:

Option Base 1
Private Sub CommandButton1_Click()
    
    Dim IdxShtName  As String
    Dim ShtName     As String
    Dim ShtNew      As Worksheet
    Dim rngHLink    As Range
    Dim shpHLink    As Shape
    Dim blnHLink    As Boolean
    Dim ColCount    As Long
    Dim ShtCount    As Long
    Dim r           As Long
    Dim c           As Long
    
    If Len(Me.TextBox1.Value) Then
        IdxShtName = Trim(Me.TextBox1.Value)
        
        On Error Resume Next
        Set ShtNew = Worksheets(IdxShtName)
        
        If Err.Number <> 0 Then
            Set ShtNew = Worksheets.Add
            ShtNew.Name = IdxShtName
        End If
        Err.Clear: On Error GoTo 0
        
        blnHLink = Me.OptionButton1.Value
        
        ColCount = Me.ComboBox1.List(Me.ComboBox1.ListIndex)
        If blnHLink Then
            ShtCount = Worksheets.Count
            With ShtNew
                r = 1
                For i = 1 To ShtCount
                    ShtName = Worksheets(i).Name
                    If ShtName <> IdxShtName Then
                        c = c + 1
                        Set rngHLink = .Cells(r, c)
                        rngHLink.Hyperlinks.Add rngHLink, Address:="", SubAddress:="'" & ShtName & "'!A1", TextToDisplay:=ShtName
                        If c Mod ColCount = 0 Then
                            r = r + 1: c = 0
                        End If
                    End If
                Next
            End With
        Else
            ShtCount = Worksheets.Count
            With ShtNew
                .Shapes.SelectAll
                Selection.Delete
                With .Cells(1).Resize(ShtCount, ColCount)
                    Debug.Print .Address
                    .Rows.RowHeight = 24
                    .Columns.ColumnWidth = 12
                End With
                r = 1
                For i = 1 To ShtCount
                    ShtName = Worksheets(i).Name
                    If ShtName <> IdxShtName Then
                        c = c + 1
                        Set rngHLink = .Cells(r, c)
                        Set shpHLink = .Shapes.AddShape(5, rngHLink.Left + 2, rngHLink.Top + 2, rngHLink.Width - 4, rngHLink.Height - 4)
                        shpHLink.TextFrame2.TextRange.Text = ShtName
                        .Hyperlinks.Add shpHLink, Address:="", SubAddress:="'" & ShtName & "'!A1", TextToDisplay:=ShtName
                        If c Mod ColCount = 0 Then
                            r = r + 1: c = 0
                        End If
                    End If
                Next
            End With
        End If
    End If
        
End Sub

Private Sub CommandButton2_Click()
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    
    Dim i       As Long
    Dim c(10)   As Long
    
    For i = 1 To 10: c(i) = i: Next
    With Me.ComboBox1
        .Style = fmStyleDropDownList
        .List = c
        .ListIndex = 0
    End With
    
    Me.OptionButton1.Value = True
    
End Sub