Excel中的VBA参考表名

我们有一堆excel文件。 第一个工作表是一个“search页面”的东西…我们想要input电子表格名称(例如在单元格A1中),然后自动popup正确的电子表格(在同一个文件中) 。

我试过了,它根本不起作用:

Function ActivateWB(wbname As String) 'Open wbname. Workbooks(wbname).Activate End Function 

下面两个代码集

  1. 添加完整的超链接目录页面
  2. 对于您在第一张纸上查找A1引用的工作表的具体问题,请参阅“JumpSheet”代码(在底部)

样品TOC

创buildTOC

 Option Explicit Sub CreateTOC() Dim ws As Worksheet Dim nmToc As Name Dim rng1 As Range Dim lngProceed As Boolean Dim bNonWkSht As Boolean Dim lngSht As Long Dim lngShtNum As Long Dim strWScode As String Dim vbCodeMod 'Test for an ActiveWorkbook to summarise If ActiveWorkbook Is Nothing Then MsgBox "You must have a workbook open first!", vbInformation, "No Open Book" Exit Sub End If 'Turn off updates, alerts and events With Application .ScreenUpdating = False .DisplayAlerts = False .EnableEvents = False End With 'If the Table of Contents exists (using a marker range name "TOC_Index") prompt the user whether to proceed On Error Resume Next Set nmToc = ActiveWorkbook.Names("TOC_Index") If Not nmToc Is Nothing Then lngProceed = MsgBox("Index exists!" & vbCrLf & "Do you want to overwrite it?", vbYesNo + vbCritical, "Warning") If lngProceed = vbYes Then Exit Sub Else ActiveWorkbook.Sheets(Range("TOC_Index").Parent.Name).Delete End If End If Set ws = ActiveWorkbook.Sheets.Add ws.Move before:=Sheets(1) 'Add the marker range name ActiveWorkbook.Names.Add "TOC_INDEX", ws.[a1] ws.Name = "TOC_Index" On Error GoTo 0 On Error GoTo ErrHandler For lngSht = 2 To ActiveWorkbook.Sheets.Count 'set to start at A6 of TOC sheet 'Test sheets to determine whether they are normal worksheets ws.Cells(lngSht + 4, 2).Value = TypeName(ActiveWorkbook.Sheets(lngSht)) If TypeName(ActiveWorkbook.Sheets(lngSht)) = "Worksheet" Then 'Add hyperlinks to normal worksheets ws.Hyperlinks.Add Anchor:=ws.Cells(lngSht + 4, 1), Address:="", SubAddress:="'" & ActiveWorkbook.Sheets(lngSht).Name & "'!A1", TextToDisplay:=ActiveWorkbook.Sheets(lngSht).Name Else 'Add name of any non-worksheets ws.Cells(lngSht + 4, 1).Value = ActiveWorkbook.Sheets(lngSht).Name 'Colour these sheets yellow ws.Cells(lngSht + 4, 1).Interior.Color = vbYellow ws.Cells(lngSht + 4, 2).Font.Italic = True bNonWkSht = True End If Next lngSht 'Add headers and formatting With ws With .[a1:a4] .Value = Application.Transpose(Array(ActiveWorkbook.Name, "", Format(Now(), "dd-mmm-yy hh:mm"), ActiveWorkbook.Sheets.Count - 1 & " sheets")) .Font.Size = 14 .Cells(1).Font.Bold = True End With With .[a6].Resize(lngSht - 1, 1) .Font.Bold = True .Font.ColorIndex = 41 .Resize(1, 2).EntireColumn.HorizontalAlignment = xlLeft .Columns("A:B").EntireColumn.AutoFit End With End With 'Add warnings and macro code if there are non WorkSheet types present If bNonWkSht Then With ws.[A5] .Value = "This workbook contains at least one Chart or Dialog Sheet. These sheets will only be activated if macros are enabled (NB: Please doubleclick yellow sheet names to select them)" .Font.ColorIndex = 3 .Font.Italic = True End With strWScode = "Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)" & vbCrLf _ & " Dim rng1 As Range" & vbCrLf _ & " Set rng1 = Intersect(Target, Range([a6], Cells(Rows.Count, 1).End(xlUp)))" & vbCrLf _ & " If rng1 Is Nothing Then Exit Sub" & vbCrLf _ & " On Error Resume Next" & vbCrLf _ & " If Target.Cells(1).Offset(0, 1) <> ""Worksheet"" Then Sheets(Target.Value).Activate" & vbCrLf _ & " If Err.Number <> 0 Then MsgBox ""Could not select sheet"" & Target.Value" & vbCrLf _ & "End Sub" & vbCrLf Set vbCodeMod = ActiveWorkbook.VBProject.VBComponents(ws.CodeName) vbCodeMod.CodeModule.AddFromString strWScode End If 'tidy up Application settins With Application .ScreenUpdating = True .DisplayAlerts = True .EnableEvents = True End With ErrHandler: If Err.Number <> 0 Then MsgBox Err.Description & vbCrLf & "Please note that your Application settings have been reset", vbCritical, "Code Error!" End Sub 

跳转表

  Sub JumpSheet() Dim ws As Worksheet On Error Resume Next Set ws = Sheets(Sheets(1).[a1].Value) On Error GoTo 0 If Not ws Is Nothing Then Application.Goto ws.[a1] Else MsgBox "Sheet not found", vbCritical End If End Sub 

遍历当前工作簿的所有页面,并激活名称正确的页面。 这里有一些代码应该给你的想法,你可以把它放在你的search表的代码部分,并将其与button的“点击”事件关联。

 Option Explicit Sub Search_Click() Dim sheetName As String, i As Long sheetName = Range("A1") For i = 1 To ThisWorkbook.Sheets.Count If ThisWorkbook.Sheets(i).Name = sheetName Then ThisWorkbook.Sheets(i).Activate Exit For End If Next End Sub 

我只是对这个问题感到困惑。 你想打开工作簿或工作表吗?

如果您尝试在工作簿中导航到工作表,例如Worksheets(“Sheet2”)。激活