Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
How do I automate the moving between tabs in a form?
I'd like to make a form tab index, button 1, 2, 3,
which will then take me to tab 1, 2,3 in a multipage box How do I call up the form tab? and no "alt-tab" or "tab" answer will do.. vba please. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
How do I automate the moving between tabs in a form?
The easiest thing would be Insert Hyperlink Place in this document...then
type in the cell reference...probably A1. If you really want a macro to do this... Link your button to this macro: Sub BuildTOC_A3() Cells(3, 1).Select BuildTOC End Sub That will call this... Sub BuildTOC() 'listed from active cell down 7-cols -- DMcRitchie 1999-08-14 2000-09-05 Dim iSheet As Long, iBefore As Long Dim sSheetName As String, sActiveCell As String Dim cRow As Long, cCol As Long, cSht As Long Dim lastcell Dim qSht As String Dim mg As String Dim rg As Range Dim CRLF As String Dim Reply As Variant Application.Calculation = xlCalculationManual Application.ScreenUpdating = False cRow = ActiveCell.Row cCol = ActiveCell.Column sSheetName = UCase(ActiveSheet.Name) sActiveCell = UCase(ActiveCell.Value) mg = "" CRLF = Chr(10) 'Actually just CR Set rg = Range(Cells(cRow, cCol), Cells(cRow - 1 + ActiveWorkbook.Sheets.Count, cCol + 7)) rg.Select If sSheetName < "$$TOC" Then mg = mg & "Sheetname is not $$TOC" & CRLF If sActiveCell < "$$TOC" Then mg = mg & "Selected cell value is not $$TOC" & CRLF If mg < "" Then mg = "Warning BuildTOC will destructively rewrite the selected area" _ & CRLF & CRLF & mg & CRLF & "Press OK to proceed, " _ & "the affected area will be rewritten, or" & CRLF & _ "Press CANCEL to check area then reinvoke this macro (BuildTOC)" Application.ScreenUpdating = True 'make range visible Reply = MsgBox(mg, vbOKCancel, "Create TOC for " & ActiveWorkbook.Sheets.Count _ & " items in workbook" & Chr(10) & "revised will now occupy up to 10 columns") Application.ScreenUpdating = False If Reply < 1 Then GoTo AbortCode End If rg.Clear 'Clear out any previous hyperlinks, fonts, etc in the area For cSht = 1 To ActiveWorkbook.Sheets.Count Cells(cRow - 1 + cSht, cCol) = "'" & Sheets(cSht).Name If TypeName(Sheets(cSht)) = "Worksheet" Then 'hypName = "'" & Sheets(csht).Name ' qSht = Replace(Sheets(cSht).Name, """", """""") -- replace not in XL97 qSht = Application.Substitute(Sheets(cSht).Name, """", """""") If CDbl(Application.Version) < 8# Then '-- use next line for XL95 Cells(cRow - 1 + cSht, cCol + 2) = "'" & Sheets(cSht).Name 'XL95 Else '-- Only for XL97, XL98, XL2000 -- will create hyperlink & codename Cells(cRow - 1 + cSht, cCol + 2) = "'" & Sheets(cSht).CodeName '--- excel is not handling lots of objects well --- 'ActiveSheet.Hyperlinks.Add Anchor:=Cells(cRow - 1 + cSht, cCol), _ ' Address:="", SubAddress:="'" & Sheets(cSht).Name & "'!A1" '--- so will use the HYPERLINK formula instead --- '--- =HYPERLINK("[VLOOKUP.XLS]'$$TOC'!A1","$$TOC") ActiveSheet.Cells(cRow - 1 + cSht, cCol).Formula = _ "=hyperlink(""[" & ActiveWorkbook.Name _ & "]'" & qSht & "'!A1"",""" & qSht & """)" End If Else Cells(cRow - 1 + cSht, cCol + 2) = "'" & Sheets(cSht).Name End If Cells(cRow - 1 + cSht, cCol + 1) = TypeName(Sheets(cSht)) ' -- activate next line to include content of cell A1 for each sheet ' Cells(cRow - 1 + csht, cCol + 3) = Sheets(Sheets(csht).Name).Range("A1").Value On Error Resume Next Cells(cRow - 1 + cSht, cCol + 6) = Sheets(cSht).ScrollArea '.Address(0, 0) Cells(cRow - 1 + cSht, cCol + 7) = Sheets(cSht).PageSetup.PrintArea If TypeName(Sheets(cSht)) < "Worksheet" Then GoTo byp7 Set lastcell = Sheets(cSht).Cells.SpecialCells(xlLastCell) Cells(cRow - 1 + cSht, cCol + 4) = lastcell.Address(0, 0) Cells(cRow - 1 + cSht, cCol + 5) = lastcell.Column * lastcell.Row byp7: 'xxx On Error GoTo 0 Next cSht 'Now sort the results: 2. Type(D), 1. Name (A), 3. module(unsorted) rg.Sort Key1:=rg.Cells(1, 2), Order1:=xlDescending, Key2:=rg.Cells(1, 1) _ , Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom rg.Columns.AutoFit rg.Select 'optional 'if cells above range are blank want these headers ' Worksheet, Type, codename If cRow 1 Then If "" = Trim(Cells(cRow - 1, cCol) & Cells(cRow - 1, cCol + 1) & Cells(cRow - 1, cCol + 2)) Then Cells(cRow - 1, cCol) = "Worksheet" Cells(cRow - 1, cCol + 1) = "Type" Cells(cRow - 1, cCol + 2) = "CodeName" Cells(cRow - 1, cCol + 3) = "[opt.]" Cells(cRow - 1, cCol + 4) = "Lastcell" Cells(cRow - 1, cCol + 5) = "cells" Cells(cRow - 1, cCol + 6) = "ScrollArea" Cells(cRow - 1, cCol + 7) = "PrintArea" End If End If Application.ScreenUpdating = True Reply = MsgBox("Table of Contents created." & CRLF & CRLF & _ "Would you like the tabs in workbook also sorted", _ vbOKCancel, "Option to Sort " & ActiveWorkbook.Sheets.Count _ & " tabs in workbook") Application.ScreenUpdating = False 'If Reply = 1 Then SortALLSheets 'Invoke macro to Sort Sheet Tabs Sheets(sSheetName).Activate AbortCode: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub HTH, Ryan -- Ryan--- If this information was helpful, please indicate this by clicking ''Yes''. "Benjamin" wrote: I'd like to make a form tab index, button 1, 2, 3, which will then take me to tab 1, 2,3 in a multipage box How do I call up the form tab? and no "alt-tab" or "tab" answer will do.. vba please. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
how can i automate copying of tabs to a new workbook? | Excel Programming | |||
How do I automate moving data when.... | New Users to Excel | |||
Automate moving between pages on a pivot table | Excel Programming | |||
How can I automate the naming of worksheet tabs? | Excel Discussion (Misc queries) | |||
How to automate custom footer on all tabs | Excel Discussion (Misc queries) |