咨询专家：易用宝 创建返回索引的超链接的问题

ZGW_QQ

请教：安装了最新的易用宝1.1.0      点工作表管理  ---创建工作表链接列表    里面有个复选框 “ 创建返回索引的超链接” ，勾 选操作和不勾选操作，结果都 是一样的，创建不了返回索引的超链接，这是怎么回事？

心电感应

勾选创建返回索引的超链接，返回的超链接在其他工作表B1单元格。

lockheed007

心电感应 发表于 2017-5-28 19:32
勾选创建返回索引的超链接，返回的超链接在其他工作表B1单元格。

大神，能帮我编一段程序吗？

1024kb

严重建议不要勾选，勾选之后会把目标工作表的B1单元格清空，还没发撤销，非常坑爹。提过这个问题，但是版本很久没更新了。我自己写了一段代码，比较笨的办法，基本上都是从录制宏里扒出来的，用的最基本的语句。放在了模板文件里，在自定义功能区创建了按钮，关联到这段代码。

Sub IndexAllSheets()
'建立所有工作表的索引，并在各工作表B1单元格建立返回索引页的链接
    On Error GoTo msg '如果已有名为“索引”的工作表，将弹出通知要求修改
    Sheets.Add.Name = "索引"
    Cells(1, 1) = "次序"
    Cells(1, 2) = "工作表链接"
    Cells(1, 3) = "是否隐藏"
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
   
    If Sheets("索引").Index > 1 Then
    If Sheets(1).Visible = False Then
    Sheets(1).Visible = True
    Sheets("索引").Move before:=Sheets(1)
    Sheets(2).Visible = False
    Else
    Sheets("索引").Move before:=Sheets(1)
    End If '将索引工作表挪到第一个工作表之前，如果第一个工作表被隐藏，需要先将其设为可见再恢复隐藏
    End If
   
    For i = 2 To Sheets.Count
     Sheets("索引").Cells(i, 1) = i
     Sheets("索引").Cells(i, 2) = Sheets(i).Name
     
     If Sheets(i).Visible = False Then '由于需要激活目标工作表以便寻找第一个可见单元格，所以需要临时将被隐藏的工作表恢复可见
        Sheets("索引").Cells(i, 3) = "已隐藏"
        Sheets("索引").Hyperlinks.Add anchor:=Sheets("索引").Cells(i, 2), Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1"
        Sheets(i).Visible = True
        Sheets(i).Activate
        Cells(1, 1).End(xlToRight).End(xlToLeft).End(xlDown).End(xlUp).Select '选定第一个可见单元格
      If WorksheetFunction.CountA(Selection) = 0 Then
        ActiveSheet.Hyperlinks.Add anchor:=Selection, Address:="", SubAddress:="索引!B" & i, TextToDisplay:="返回索引"
      Else
        ActiveSheet.Hyperlinks.Add anchor:=Selection, Address:="", SubAddress:="索引!B" & i, ScreenTip:="返回索引"
      End If
        Sheets(i).Visible = False
      
      Else
        Sheets("索引").Hyperlinks.Add anchor:=Sheets("索引").Cells(i, 2), Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1"
        Sheets(i).Activate
        Cells(1, 1).End(xlToRight).End(xlToLeft).End(xlDown).End(xlUp).Select
      If WorksheetFunction.CountA(Selection) = 0 Then
        ActiveSheet.Hyperlinks.Add anchor:=Selection, Address:="", SubAddress:="索引!B" & i, TextToDisplay:="返回索引"
      Else
        ActiveSheet.Hyperlinks.Add anchor:=Selection, Address:="", SubAddress:="索引!B" & i, ScreenTip:="返回索引"
      End If
     End If
     
    Next i
   
    Sheets("索引").Activate
    Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    With Selection.Font
        .Name = "Calibri Light"
        .Size = 12
    End With
    Cells(1, 1).Select
    Columns("A:C").EntireColumn.AutoFit
    Windows("Book.xltm").Close
    Exit Sub
   
msg:
    MsgBox ("工作簿中已存在名为“索引”的工作表，请将其修改为其他名称后再重新建立索引。")
    Application.DisplayAlerts = False 'Excel会先增加一个以codename命名的工作表再重命名，重命名为“索引”时如果重名需要先将该空工作表删除
    If IsEmpty(ActiveSheet.UsedRange) Then ActiveSheet.Delete
    Windows("Book.xltm").Close
    Application.DisplayAlerts = True

End Sub

1024kb

心电感应 发表于 2017-5-28 19:32
勾选创建返回索引的超链接，返回的超链接在其他工作表B1单元格。

这会导致目标工作表的B1单元格被清空，而且还无法撤销，一旦点了保存就彻底瞎了，想象一下，如果有很多工作表，又没有备份，这得有多坑爹。这是个严重的BUG，我发帖提过，到现在还没改。