Untitled
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...