Untitled

 avatar
unknown
plain_text
2 years ago
2.5 kB
5
Indexable
Sub CreateWorksheetList()

    ' Declare variables
    Dim ws As Worksheet
    Dim wsList() As String
    Dim i As Integer
    Dim j As Integer
    Dim str As String
    
    ' Get the number of worksheets in the workbook
    i = ActiveWorkbook.Worksheets.Count
    
    ' Redimension the array to the number of worksheets
    ReDim wsList(1 To i)
    
    ' Loop through all worksheets and add their names to the array
    For j = 1 To i
        wsList(j) = ActiveWorkbook.Worksheets(j).Name
    Next j
    
    ' Sort the array alphabetically
    Call BubbleSort(wsList, i)
    
    ' Create a new sheet for the worksheet list
    Set ws = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Sheets(i))
    ws.Name = "Worksheet List"
    
    ' Add a drop-down list to cell A1 on the new sheet
    With ws.Range("A1").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(wsList, ",")
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    
    ' Add a search box to cell B1 on the new sheet
    ws.Range("B1").Value = "Search:"
    ws.Range("C1").Select
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 440, 3, 80, 15).Select
    Selection.Name = "SearchBox"
    Selection.Characters.Text = ""
    
    ' Add a button to cell D1 on the new sheet
    ws.Range("D1").Value = "Go To Worksheet"
    ws.Range("D1").HorizontalAlignment = xlCenter
    ws.Range("D1").VerticalAlignment = xlCenter
    With ws.Range("D1").Font
        .Bold = True
    End With
    With ws.Range("D1").Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    With ws.Range("D1").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    ' Add a macro to the button that navigates to the selected worksheet
    With ws.Buttons.Add(ws.Range("D1").Left, ws.Range("D1").Top, ws.Range("D1").Width, ws.Range("D1").Height)
        .OnAction = "GoToWorksheet"
        .Caption = "Go To Worksheet"
        .Name = "GoToWorksheetButton"
        .Characters.Font.Size = 10
        .Characters.Font.Bold = True
    End With
    
End Sub

Sub GoToWorksheet()

    ' Declare variables
   
Editor is loading...