Создание страницы индекса Excel Macro

Question

Я работаю над созданием страницы индекса в своей книге Excel, поскольку она составлена ​​из многих рабочих листов. Приведенный ниже код должен вставить новую строку, начиная с ячейки A1, и создать гипер ссылку, которая связывает каждый лист с индексом, однако у меня все время возникает проблема, когда каждый раз я нажимаю Back to Index another «Back to Index» Создается гиперссылка, есть ли у меня какой-то цикл в моем коде? Я несколько новичок в VBA, и пока не вижу больших расшифровки. Большое спасибо за любую ожидаемую помощь! :)

Sub Worksheet_Activate() 
    Dim wSheet As Worksheet 
    Dim l As Long 

    l = 1 

    With Me 
     .Columns(1).ClearContents 
     .Cells(1, 1) = "INDEX" 
     .Cells(1, 1).Name = "Index" 
    End With 

    For Each wSheet In Worksheets 
     If wSheet.Name <> Me.Name Then 
      l = l + 1 
      With wSheet 
       .Range("A1").Name = "Start_" & wSheet.Index 
       .Range("A1").EntireRow.Insert 
       .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _ 
       SubAddress:="Index", TextToDisplay:="Back to Index" 
      End With 
      Me.Hyperlinks.Add Anchor:=Me.Cells(l, 1), Address:="", _ 
     SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name 
     End If 
    Next wSheet 
End Sub 

Answer 1

Проблема заключается в том, что это событие «Worksheet_Activate()». Каждый раз, когда вы активируете этот рабочий лист (я предполагаю, что это рабочий лист Index), он запускает этот код, который перемещается по каждому листу, который не является листом Index, и вставляет новую строку с гиперссылкой.

Поскольку вам нужно всего лишь запустить этот раз, а затем вытащите его из Worksheet_Activate() и дайте ему свою собственную подпрограмму. Вы можете вызвать его, когда это необходимо, но не каждый раз, когда вы активируете вкладку Index.

В качестве альтернативы вы можете проверить, была ли сделана гиперссылка на каждом листе, а если она есть, пропустите этот бит макроса. Что-то вроде:

Sub Worksheet_Activate() 
    Dim wSheet As Worksheet 
    Dim l As Long 

    l = 1 

    With Me 
     .Columns(1).ClearContents 
     .Cells(1, 1) = "INDEX" 
     .Cells(1, 1).Name = "Index" 
    End With 

    For Each wSheet In Worksheets 
     'Added a check to see if the hyperlink has been created yet already for each sheet 
     If wSheet.Name <> Me.Name AND NOT(wSheet.Range("A1").Value = "Back to Index") Then 
      l = l + 1 
      With wSheet 
       .Range("A1").Name = "Start_" & wSheet.Index 
       .Range("A1").EntireRow.Insert 
       .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _ 
       SubAddress:="Index", TextToDisplay:="Back to Index" 
      End With 
      Me.Hyperlinks.Add Anchor:=Me.Cells(l, 1), Address:="", _ 
     SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name 
     End If 
    Next wSheet 
End Sub 

Answer 2

Попробуйте это:

Sub Worksheet_Activate() 
Dim wSheet As Worksheet 
Dim l As Long 

l = 1 

With Me 
    .Columns(1).ClearContents 
    .Cells(1, 1) = "INDEX" 
    .Cells(1, 1).Name = "Index" 
End With 

For Each wSheet In Worksheets 
    If wSheet.Name <> Me.Name Then 
     l = l + 1 
     With wSheet 
      .Range("A1").Name = "Start_" & wSheet.Index 
      .Range("A1").EntireRow.Insert 
     End With 
     Me.Hyperlinks.Add Anchor:=Me.Cells(l, 1), Address:="", _ 
    SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name 
    End If 
Next wSheet 
End Sub