关于隐藏超连接如何实现

骑猪返北流

各位，我是新手，请问一下怎么实现隐藏的超连接功能呀。就是只留一个工作表，已经设置好其它表的连接了。其余的隐藏了。怎么做可以点击就能去到相应的表上，用后又隐藏起来。最好有图解了。谢谢

tiankongwuy

加个控件按钮   

骑猪返北流

怎么做呀，能详细些么

jkczfpb

回复 骑猪返北流 的帖子

在工作簿中新建一个工作表，将以下代码粘贴到工作表VBE窗口中，随便选择2个及以上单元格，按删除键，即可

1. Private Sub Worksheet_Activate()
   
2. On Error Resume Next
   
3. Dim i As Integer, shme As String
   
4. shme = ActiveSheet.Name
   
5. For i = 1 To Sheets.Count
   
6. If Sheets(i).Name <> shme Then Sheets(i).Visible = 2
   
7. Next
   
8. End Sub
   
9. Private Sub Worksheet_Change(ByVal Target As Range)
   
10. Dim i As Byte
    
11. If Target.Count > 1 And Target.Text = "" Then
    
12. If MsgBox(vbCrLf & "注意：" & vbCrLf + vbCrLf & "选择“是”将清除当前工作表数据，更新工作表目录;" & vbCrLf + vbCrLf & "选择“否”不执行程序。", vbYesNo + vbQuestion + vbDefaultButton1, "注意：是否重新建立目录工作表！！！") <> 6 Then Exit Sub
    
13. With Application
    
14. .DisplayAlerts = False '打开对话框提示
    
15. .EnableEvents = False '启用事件
    
16. .ScreenUpdating = False '打开屏幕更新
    
17. End With
    
18. With ActiveSheet
    
19. .Cells.Clear
    
20. .Name = "目录"
    
21. .Cells(1).Value = "工作表名称列表"
    
22. .Cells(1).HorizontalAlignment = xlCenter '水平居中
    
23. .Cells(2, 1).Value = "目录"
    
24. For i = 2 To Sheets.Count
    
25. .Cells(i + 1, 1).Value = Sheets(i).Name
    
26. Next
    
27. .Columns(1).AutoFit
    
28. .Cells(1).CurrentRegion.NumberFormatLocal = " @"
    
29. End With
    
30. With Application
    
31. .DisplayAlerts = True '打开对话框提示
    
32. .EnableEvents = True '启用事件
    
33. .ScreenUpdating = True '打开屏幕更新
    
34. End With
    
35. End If
    
36. End Sub
    
37. 
    
38. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
39. On Error Resume Next
    
40. If Target.Row > 2 And Target.Column = 1 And Target.Count = 1 Then
    
41. Sheets(Target.Value).Visible = -1
    
42. Sheets(Target.Value).Activate
    
43. End If
    
44. End Sub
    

复制代码