toffee_girl
New Member
- Joined
- Sep 16, 2016
- Messages
- 3
Hi Everyone,
Hoping somebody can help me before I throw my lap top through the window...!
I attempted to write a macro which was supposed to add a contents page with links to all other worksheets and then on each of those worksheets insert a shape with a link back to the contents page. After about 100 attempts the macro worked fine - until I tried to save it as a personal macro. Now when I run it the initial part works and it creates the contents page and adds the shapes but when I try to click back on the shape I get an error message to say "Cannot run the Macro 'Module2.ContentsSelect'. The Macro may not be available in this workbook or all macros may be disabled.
Any help would be much appreciated !
Hoping somebody can help me before I throw my lap top through the window...!
I attempted to write a macro which was supposed to add a contents page with links to all other worksheets and then on each of those worksheets insert a shape with a link back to the contents page. After about 100 attempts the macro worked fine - until I tried to save it as a personal macro. Now when I run it the initial part works and it creates the contents page and adds the shapes but when I try to click back on the shape I get an error message to say "Cannot run the Macro 'Module2.ContentsSelect'. The Macro may not be available in this workbook or all macros may be disabled.
Any help would be much appreciated !
Code:
Sub Contents()
Dim wbBook As Workbook
Dim wsActive As Worksheet
Dim wsSheet As Worksheet
Dim lnRow As Long
Dim lnPages As Long
Dim lnCount As Long
Set wbBook = ActiveWorkbook
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
On Error Resume Next
With wbBook
.Worksheets("Contents").Delete
.Worksheets.Add Before:=.Worksheets(1)
End With
On Error GoTo 0
Set wsActive = wbBook.ActiveSheet
With wsActive
.Name = "Contents"
With .Range("B2")
.Value = VBA.Array("Table of Contents")
.Font.Bold = True
End With
End With
lnRow = 3
lnCount = 2
For Each wsSheet In wbBook.Worksheets
If wsSheet.Name <> wsActive.Name Then
wsSheet.Activate
With wsActive
.Hyperlinks.Add .Cells(lnRow, 2), "", _
SubAddress:="'" & wsSheet.Name & "'!A1", _
TextToDisplay:=wsSheet.Name
End With
lnRow = lnRow + 1
lnCount = lnCount + 1
End If
Next wsSheet
wsActive.Activate
wsActive.Columns("B").EntireColumn.AutoFit
ActiveWindow.DisplayGridlines = False
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
Set s = ws.Shapes.AddShape(51, 300, 10, 100, 30)
With s
.Fill.ForeColor.RGB = RGB(204, 193, 218)
.TextFrame.Characters.Text = "Back to Contents"
.OnAction = "Module2.ContentsSelect"
End With
Next
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
Sub ContentsSelect()
Worksheets("Contents").Activate
Range("B2").Select
End Sub