2012-01-14 117 views
2

我們有一大堆表單的excel文件。第一個表單是一個「搜索頁面」的東西......我們想要輸入我們正在查找的電子表格的名稱(例如在單元格A1中),然後會自動彈出正確的電子表格(在同一個文件中) 。excel中的VBA參考表名稱

我試過了,但它並沒有在所有的工作:在當前工作簿中的所有工作表

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

回答

2

兩個代碼設置如下

  1. 添加一個完整的超鏈接Table of Contents
  2. 爲您重新尋找一個特定紙張問題由A1上的第一張喜JumpSheet「代碼簡稱(在底部)

Sample TOC

創建TOC

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 
+1

謝謝,這真的很有用:) – 2012-01-15 02:08:27

2

迭代並激活一個恰當名字。這裏有一些代碼應該給你的想法,你可以把它放在你的搜索表的代碼部分,並將它與按鈕的「Clicked」事件相關聯。

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 
+0

感謝@doc BROWM:我剛纔已經給了它一個嘗試。例如,如果我有a,b,c,d和e五個電子表格,在A1中,我可以鍵入「a」,然後打開電子表格「a」。所以我不明白帶有Search_Click的部分,沒有點擊任何地方?! ...或者我錯過了什麼? – 2012-01-14 10:23:03

+0

@kim yr:無論如何,你可以調用sub,但不知何故電子表格的用戶必須運行這個東西。我個人認爲讓用戶猜測某個地方有一些可以通過「工具/宏」運行的宏隱藏是有點不方便的。因此,作爲建議,*您可以在電子表格上放置*按鈕並將其與此搜索代碼關聯。 – 2012-01-15 07:47:47

0

我只是困惑的問題。您是否嘗試打開工作簿或工作表?

如果你想瀏覽與工作簿, 例如到工作表 工作表( 「Sheet2的」)激活