We have to create a table of content in Excel worksheet where there will be a sheet hyper link for every data in TOC sheet except Header
VBA Code:
Sub toc()
Dim wkb As Workbook
Dim wks As Worksheet
Dim wkscount As Integer
Dim lp As Integer
Dim wkbname As String
Dim path As String
Set wkb = ActiveWorkbook
wkscount = wkb.Sheets.Count
Set wks = wkb.Sheets.Add(before:=wkb.Sheets(1))
wks.Name = "TOC"
ActiveSheet.Range("a1").Value = "Table of Content"
For lp = 2 To wkscount + 1
wkbname = wkb.Sheets(lp).Name
ActiveSheet.Range("a" & lp).Value = wkbname
path = "file:///" & wkb.path
MsgBox (ActiveCell.Offset((lp - 1), 0).Address)
'Range("A" & lp).Select
'MsgBox (path)
ActiveCell.Offset((lp - 1), 0).Hyperlinks.Add Anchor:=ActiveCell.Offset((lp - 1), 0), Address:="", SubAddress:= _
ActiveCell.Offset((lp - 1), 0).Value & "!A1", TextToDisplay:=wkbname
'MsgBox wkscount
Next lp
End Sub
VBA Code:
Sub toc()
Dim wkb As Workbook
Dim wks As Worksheet
Dim wkscount As Integer
Dim lp As Integer
Dim wkbname As String
Dim path As String
Set wkb = ActiveWorkbook
wkscount = wkb.Sheets.Count
Set wks = wkb.Sheets.Add(before:=wkb.Sheets(1))
wks.Name = "TOC"
ActiveSheet.Range("a1").Value = "Table of Content"
For lp = 2 To wkscount + 1
wkbname = wkb.Sheets(lp).Name
ActiveSheet.Range("a" & lp).Value = wkbname
path = "file:///" & wkb.path
MsgBox (ActiveCell.Offset((lp - 1), 0).Address)
'Range("A" & lp).Select
'MsgBox (path)
ActiveCell.Offset((lp - 1), 0).Hyperlinks.Add Anchor:=ActiveCell.Offset((lp - 1), 0), Address:="", SubAddress:= _
ActiveCell.Offset((lp - 1), 0).Value & "!A1", TextToDisplay:=wkbname
'MsgBox wkscount
Next lp
End Sub
No comments:
Post a Comment