mycode01-建立超链接目录

小马爱会计

mycode01-建立超链接目录

ayouxiaopy

Sub 提取工作表名()
    Dim i As Integer '定义i为整型变量
    On Error Resume Next '防止工作簿里没有目录工作表，在删除时报错
    Application.DisplayAlerts = False '关闭询问对话框
    Worksheets("目录").Delete '删除目录工作表
    Application.DisplayAlerts = True '打开询问对话框
    Sheets.Add before:=Sheets(1) '在第一个工作表前插入一张新的工作表
    Sheets(1).Name = "目录" '把第一个工作表取名为"目录"
    Cells(1, 1) = "目录" '在目录工作表中的A1单元写于"目录"两字
    For i = 2 To Worksheets.Count 'Worksheets.Count统计工作表的总数，整句代码的意思遍历每一个作表
        Worksheets(1).Activate '一定要加上这一句，由于我们为了添加按钮时，把添加按钮的那个工作表设置为活动工作表，添加之后还要把“目录”工作表设置为当前工作表
        Cells(i, 1) = Sheets(i).Name '依次把工作表的名字写A列
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:="", _
        SubAddress:=Worksheets(i).Name & "!A1", TextToDisplay:=Cells(i, 1).Value
   '由代码过长，先打一个_然后加一个空格，这是把代码分行
   ' 根据录制的代码修改，把选中的Selection改为Cells(i,1),把 "Sheet3!A1"改为Worksheets(i).Name & "!A1"，一定要是记得是工作表名
   '所以加了一个Name属性，把“佛山小老鼠”改为Cells(i, 1).Value
  ' 添加“返回目录”按钮
   '因为2007录制不了艺术字代码，2003和2010可以，下面的代码是我在2003版里录制修改后的
  Worksheets(i).Shapes.AddTextEffect(msoTextEffect32, "返回目录", "黑体", 16#, _
        msoTrue, msoFalse, 600#, 20.25).Select
        Sheets(i).Select
    Sheets(i).Activate
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:= _
        "", SubAddress:=Worksheets(1).Name & "!A1"
   Range("A1").Select
    Next i '下一个i
End Sub
Sub 清空()
    Dim Sp As Shape, sh As Worksheet
    Worksheets("目录").Columns("A").Clear
    For Each sh In Worksheets
        sh.Activate
        For Each Sp In ActiveSheet.Shapes
            Sp.Delete
        Next Sp
    Next sh
End Sub

ayouxiaopy

上面来自佛山小老鼠老师的汇总，感谢老师