请求编写Excel VBA代码：创建带超链接的工作表索引形状及返回按钮

Got it, let's build this intuitive navigation system for your Excel workbook. Below is a complete VBA solution that does exactly what you need—plus clean formatting to make the shapes look professional and easy to use.

The Complete Code #

Paste this into a new VBA module in your workbook:

' Constants for easy customization
Const INDEX_SHEET_NAME As String = "Index"
Const RETURN_SHAPE_NAME As String = "ReturnToIndex"
Const SHAPE_HEIGHT As Integer = 25
Const SHAPE_WIDTH As Integer = 120
Const START_TOP As Integer = 50
Const SPACE_BETWEEN As Integer = 30

Sub CreateNavigationShapes()
    Dim indexWs As Worksheet
    Dim ws As Worksheet
    Dim shp As Shape
    Dim topPos As Integer
    
    ' Check if index sheet exists; create it if missing
    On Error Resume Next
    Set indexWs = ThisWorkbook.Worksheets(INDEX_SHEET_NAME)
    On Error GoTo 0
    
    If indexWs Is Nothing Then
        Set indexWs = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        indexWs.Name = INDEX_SHEET_NAME
    End If
    
    ' Clear existing shapes in index sheet to avoid duplicates
    For Each shp In indexWs.Shapes
        shp.Delete
    Next shp
    
    ' Build navigation shapes in index sheet
    topPos = START_TOP
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> INDEX_SHEET_NAME Then
            ' Create rectangle shape
            Set shp = indexWs.Shapes.AddShape(msoShapeRectangle, 50, topPos, SHAPE_WIDTH, SHAPE_HEIGHT)
            
            ' Format shape for visibility and clarity
            shp.Name = "GoTo_" & ws.Name
            shp.TextFrame2.TextRange.Text = ws.Name
            shp.TextFrame2.TextRange.Font.Size = 12
            shp.TextFrame2.TextRange.Font.Bold = True
            shp.TextFrame2.VerticalAnchor = msoAnchorMiddle
            shp.TextFrame2.HorizontalAnchor = msoAnchorCenter
            shp.Fill.ForeColor.RGB = RGB(189, 215, 238) ' Light blue fill
            shp.Line.ForeColor.RGB = RGB(0, 0, 0) ' Black border
            shp.Line.Weight = 1
            
            ' Link shape to jump macro
            shp.OnAction = "GoToSheet"
            
            ' Move to next vertical position
            topPos = topPos + SHAPE_HEIGHT + SPACE_BETWEEN
        End If
    Next ws
    
    ' Add "Return to Index" shapes to all other sheets
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> INDEX_SHEET_NAME Then
            ' Skip if return shape already exists
            Dim shapeExists As Boolean
            shapeExists = False
            For Each shp In ws.Shapes
                If shp.Name = RETURN_SHAPE_NAME Then
                    shapeExists = True
                    Exit For
                End If
            Next shp
            
            If Not shapeExists Then
                ' Create return shape in top-right area
                Set shp = ws.Shapes.AddShape(msoShapeRectangle, _
                    ws.Cells(1, ws.Columns.Count).End(xlToLeft).Offset(0, 2).Left, _
                    50, SHAPE_WIDTH, SHAPE_HEIGHT)
                
                ' Format return shape
                shp.Name = RETURN_SHAPE_NAME
                shp.TextFrame2.TextRange.Text = "返回索引"
                shp.TextFrame2.TextRange.Font.Size = 12
                shp.TextFrame2.TextRange.Font.Bold = True
                shp.TextFrame2.VerticalAnchor = msoAnchorMiddle
                shp.TextFrame2.HorizontalAnchor = msoAnchorCenter
                shp.Fill.ForeColor.RGB = RGB(255, 199, 206) ' Light red fill
                shp.Line.ForeColor.RGB = RGB(0, 0, 0)
                shp.Line.Weight = 1
                
                ' Link to index macro
                shp.OnAction = "GoToIndex"
            End If
        End If
    Next ws
    
    MsgBox "Navigation system created successfully!", vbInformation
End Sub

' Helper macro: Jump to target sheet's A1
Sub GoToSheet()
    Dim targetSheetName As String
    Dim targetWs As Worksheet
    
    targetSheetName = Replace(Application.Caller, "GoTo_", "")
    
    On Error Resume Next
    Set targetWs = ThisWorkbook.Worksheets(targetSheetName)
    On Error GoTo 0
    
    If Not targetWs Is Nothing Then
        targetWs.Activate
        targetWs.Range("A1").Select
    Else
        MsgBox "Target sheet not found!", vbExclamation
    End If
End Sub

' Helper macro: Jump back to index sheet's A1
Sub GoToIndex()
    Dim indexWs As Worksheet
    
    On Error Resume Next
    Set indexWs = ThisWorkbook.Worksheets(INDEX_SHEET_NAME)
    On Error GoTo 0
    
    If Not indexWs Is Nothing Then
        indexWs.Activate
        indexWs.Range("A1").Select
    Else
        MsgBox "Index sheet not found!", vbExclamation
    End If
End Sub

How It Works #

1. Index Sheet Setup:

   • Automatically creates an "Index" sheet if it doesn't exist.
   • Clears old shapes to avoid duplicates when re-running the macro.
   • Adds vertically arranged blue rectangles for every worksheet (except the index itself). Clicking any rectangle jumps directly to that sheet's cell A1.

2. Return Navigation:

   • Adds a red "返回索引" rectangle to every non-index sheet (only if it doesn't already exist).
   • Places the return shape in the top-right corner of each sheet, out of the way of your data.

3. Customization:

   • Tweak the constants at the top to change the index sheet name, shape sizes, colors, or spacing to match your workbook's style.

How to Use #

1. Open your Excel workbook.
2. Press Alt + F11 to open the VBA Editor.
3. Right-click your workbook in the Project Explorer > Insert > Module.
4. Paste the code into the new module.
5. Run the CreateNavigationShapes macro (either from the editor, or assign it to a button in Excel for quick access later).

内容的提问来源于stack exchange，提问作者Misbah Azeez