PDA

View Full Version : 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/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.9BLeCWVhxdG9wgNsaS3Lp1)
https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgR1EPUkhw (https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgR1EPUkhw)
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (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.


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

Admin
09-04-2012, 04:08 PM
TomyLee,

Happy b'day. Have a great year ahead.

Ingolf
09-04-2012, 08:33 PM
Thank you for a great code.

TomyLee
09-04-2012, 08:46 PM
Hello Admin,

Thanks for the wishes. Also thanks for the code, it's perfect for me.
Thank you. I wish you an excellent day.

TomyLee

Admin
09-04-2012, 10:52 PM
Hi Tomy/Ingolf

Thanks for the feedback. :cheers: