index, create hyperlink

Option Explicit
Dim ws As Worksheet, Reference As Worksheet, sht As Worksheet
Dim i As Integer, j As Integer, LastRow As Integer, lastcolumn As Integer
Dim m As Integer, n As Integer
Dim ValueDate As Date
Dim sheetname As String
Dim t As String, nsht() As String

'显示全部工作表
Sub Show_All()
Application.ScreenUpdating = False
    For i = 1 To Sheets.count
        Sheets(i).Visible = True
    Next i
Call HyperLink
Call ShowColor
Application.ScreenUpdating = True
End Sub

'Index to Tab
Sub Index_Tab()
Application.ScreenUpdating = False
n = Sheets.count
'按照Index表的顺序排序
ReDim nsht(1 To n)
With ThisWorkbook.Worksheets("Index")
    For i = 1 To n
        nsht(i) = .Cells(i + 3, 2).Text
    Next i
    For i = n To 2 Step -1
        Sheets(nsht(i)).Move after:=Sheets("Index")
    Next i
End With
Call ShowColor
Call HyperLink

Worksheets("Index").Select
Application.ScreenUpdating = True
End Sub

'Tab to Index
Sub Tab_Index()
Application.ScreenUpdating = False
    n = Sheets.count

    With ThisWorkbook.Worksheets("Index")
        .Range(.Cells(n + 3, 1), .Cells(n + 100, 4)).ClearContents
        For i = 5 To n
            .Cells(i, 1) = i - 3
            .Cells(i, 2) = Sheets(i - 3).name
        Next i
    End With
Call ShowColor
Call HyperLink
Worksheets("Index").Select
Application.ScreenUpdating = True
End Sub


'显示选定的工作表
Sub Show_Select()
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Index")
    LastRow = .Cells(4, 1).End(xlDown).Row
    For i = 5 To LastRow
        sheetname = .Cells(i, 2)
        Select Case .Cells(i, 3)
            Case 1
                ThisWorkbook.Worksheets(sheetname).Visible = True
            Case Else
                ThisWorkbook.Worksheets(sheetname).Visible = False
        End Select
    Next i
End With
sheetname = ""
Application.ScreenUpdating = True
End Sub


'删除选定的工作表
Sub Delete_Select()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ThisWorkbook.Worksheets("Index")
    LastRow = .Cells(4, 1).End(xlDown).Row
    For i = 5 To LastRow
        sheetname = .Cells(i, 2)
        If .Cells(i, 3) = 1 Then
            On Error Resume Next
            ThisWorkbook.Worksheets(sheetname).Delete
        End If
    Next i
End With
sheetname = ""
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Sub ShowColor()
'确定行是否标色
With Worksheets("Index")
For i = 4 To .Cells(3, 1).End(xlDown).Row + 10
    On Error Resume Next
    If InStr(.Cells(i, 2), "--") > 0 Then
        .Range(.Cells(i, 1), .Cells(i, 4)).Interior.Color = 10092543
        .Range(.Cells(i, 1), .Cells(i, 4)).Font.ThemeColor = xlThemeColorLight1
    Else
        .Range(.Cells(i, 1), .Cells(i, 4)).Interior.Pattern = xlNone
    End If
Next i
End With
End Sub

Sub HyperLink()
'在Index表建立hyperlink
With ThisWorkbook.Worksheets("Index")
n = Sheets.count
    For i = 5 To n + 3
        .Cells(i, 1) = i - 3
        .Cells(i, 2) = Sheets(i - 3).name '原来采用在Excel中定义一个名称的方式 AllSheetsName=REPLACE(GET.WORKBOOK(1),1,FIND("]",GET.WORKBOOK(1)),)&T(NOW())
        .Hyperlinks.Add Anchor:=.Cells(i, 2), Address:="", SubAddress:="'" & .Cells(i, 2).Text & "'" & "!A1", TextToDisplay:=Application.WorksheetFunction.Trim(.Cells(i, 2))
        .Cells(i, 2).Font.Underline = xlUnderlineStyleNone
    Next i
End With

'在其他表建立Hyperlink
For Each ws In Worksheets
    If ws.CodeName <> "Index" Then
        If ws.Range("A1") = "" Then
            ws.Range("A1") = "Index"
        End If
        ws.Range("A1").Hyperlinks.Add Anchor:=ws.Range("A1"), Address:="", SubAddress:="Index!A1", TextToDisplay:=Application.WorksheetFunction.Trim(ws.Range("A1").Text)
    End If
Next
End Sub


'Delete unneed styles
Sub DelCustomStyles()
Dim st As Style
For Each st In ActiveWorkbook.Styles
    On Error Resume Next
    If Not st.BuiltIn Then st.Delete
Next
End Sub