Untitled
unknown
plain_text
3 years ago
2.5 kB
8
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...