故障參考表代碼名稱

Question

這裏的基本問題：我正在寫一個Excel宏，我想用工作表代碼名來儘量消除在道路上的任何錯誤。我可以使用Sheet1的代碼名稱，它工作正常，但是當我嘗試使用其他代碼時，如Sheet3或Sheet7，編輯器不能識別它們，如果我運行宏Excel會啓動一個錯誤，告訴我我的「變量未定義「。

例如：

Option Explicit 

Sub Test() 

Dim SheetObject As Worksheet 
Dim SheetObject2 As Worksheet 

Set SheetObject = Sheet1 
Set SheetObject2 = Sheet3 

MsgBox (SheetObject.Name) 
MsgBox (SheetObject2.Name) 


End Sub 

如果我註釋掉指SheetObject2任何代碼的宏正常運行。如果我把它們放進去，我會得到錯誤。我肯定有一張Sheet3，代碼名稱絕對是Sheet3。我整天環顧Google，似乎無法提出任何解決方案，任何幫助都會很棒。

由於提前，

傑西

Answer 1

我最後的用人單位收集數據和創建國家統計。大部分數據都是以Excel工作簿的形式出現的，所以我有很多相關的經驗。

如果您運行的是自己的宏，如果這是一個一次性的練習，然後像這樣的測試可能就足夠了：

Debug.Assert WbookTgt.WsheetTgt.Range("A1").Value = "Date" 

許多語言有一個斷言語句作爲發展援助;這是VBA版本。如果斷言不成立，宏將停止並突出顯示此語句。

如果這種做法是不足夠的，你應該考慮制定參數化宏進行檢查和更新任務。我已經瀏覽了一些舊的宏，但大多數人不會理解VBA新手。我已經提取代碼來創建兩個宏，我希望能給你一些想法。

宏1 - OpenWorkbook

組織，定期提供數據經常使用的名稱類似：「XXXXX 1409.xlsx」和「XXXXX 1410.xlsx」爲自己的數據的九月和十月的版本。例如，您可以每月更新宏以獲取最新名稱，或者可以將文件名更改爲標準值。這兩種可能性都是麻煩的，我會特別反對第二種想法，因爲我喜歡將我所處理的所有工作簿存檔。

OpenWorkbook（）使用Dir語句來搜索文件夾，一個模板，如「XXXXX的* .xls *」相匹配的文件。如果單個文件與此模板匹配，宏將打開工作簿並返回對其的引用。

宏2 - CheckWorksheets

您可能已經注意到，一些VBA程序有一個固定的參數數字，而其他具有可變數量的參數。例如，以下是CheckWorksheets的所有有效調用：

If CheckWorksheets(WbookTgt, WbookThis, 「Name1」) then 
If CheckWorksheets(WbookTgt, WbookThis, 「Name1」, 「Name2」) then 
If CheckWorksheets(WbookTgt, WbookThis, 「Name1」, 「Name2」, 「Name3」) then 

CheckWorksheets有三個參數。前兩個是工作簿參考。第三個是ParamArray SheetName() As Variant。前兩個之後的任何參數都放置在數組SheetName中，該數組的大小可以根據需要設置。這裏所有的尾部參數都是字符串，但它們可以是任何類型。

我可以使用OpenWorkbook打開本月版本的源文件，然後使用CheckWorksheets確認我的宏所需的所有工作表都存在。

工作表錯誤，」

這兩個宏需要一個工作表中的錯誤出現在指定的工作簿。如果宏檢測到錯誤，則會向此工作表添加詳細的錯誤消息。我發現這是一種方便的技術來捕獲任何錯誤的細節。

宏demo1的和DEMO2

我已經包含了兩個宏演示如何使用這些宏與我的系統上的工作簿。如果您修改Demo1和Demo2以在一些工作簿上進行操作，您應該瞭解OpenWorkbook和CheckWorksheets可以爲您做些什麼。

帶回來作爲必要的，但你可以破譯OpenWorkbook和CheckWorksheets自己的越多，你會開發自己的技能

Option Explicit 
Sub Demo1() 

    Dim Path As String 
    Dim WbookThis As Workbook 
    Dim WbookTgt As Workbook 

    ' Application.ThisWorkbook identifies the workbook containing this macro. 
    Set WbookThis = Application.ThisWorkbook 

    ' I find it convenient to place my target workbooks in the folder 
    ' holding the workbook containing the macro(s). 
    Path = WbookThis.Path 

    Set WbookTgt = OpenWorkbook(Path, "Combined*.xls*", WbookThis) 

    If WbookTgt Is Nothing Then 
    ' Detailed error message already recorded in "Errors" 
    Call MsgBox("Wokbook failed checks", vbOKOnly) 
    Else 
    With WbookTgt 
     Debug.Print .Path & "\" & .Name & " opened." 
     .Close SaveChanges:=False 
    End With 
    End If 

End Sub 
Sub Demo2() 

    Dim Path As String 
    Dim WbookThis As Workbook 
    Dim WbookTgt As Workbook 

    ' Application.ThisWorkbook identifies the workbook containing this macro. 
    Set WbookThis = Application.ThisWorkbook 

    ' I find it convenient to place my target workbooks in the folder 
    ' holding the workbook containing the macro(s). 
    Path = WbookThis.Path 

    Set WbookTgt = OpenWorkbook(Path, "Combined 2.04.xls*", WbookThis) 

    If WbookTgt Is Nothing Then 
    ' Detailed error message already recorded in "Errors" 
    Call MsgBox("Wokbook failed checks", vbOKOnly) 
    Exit Sub 
    End If 
    With WbookTgt 
    If Not CheckWorksheets(WbookTgt, WbookThis, "Critical Path", "Dyn Dims") Then 
     Call MsgBox("Wokbook failed checks", vbOKOnly) 
     .Close SaveChanges:=False 
     Exit Sub 
    End If 
    Debug.Print .Path & "\" & .Name & " contains worksheets Critical and Dym Dims" 
    .Close SaveChanges:=False 
    End With 

End Sub 
Function CheckWorksheets(ByRef WbookTgt As Workbook, ByRef WbookError As Workbook, _ 
         ParamArray SheetName() As Variant) As Boolean 

    ' * Return True if WbookTgt contains every specified worksheet. 

    ' * WbookTgt is the workbook to be checked 
    ' * WbookError identifies the workbook containing worksheet "Error" to which any 
    ' error message will be added. 
    ' * SheetName() is an array of worksheet names. 

    Dim ErrorMsg As String 
    Dim FoundError As Boolean 
    Dim FoundSheet() As Boolean 
    Dim FoundSheetsCount As Long 
    Dim InxName As Long 
    Dim InxWsheet As Long 
    Dim NotFoundSheetsCount As Long 
    Dim RowErrorNext As Long 
    Dim SheetNamesFound As String 

    ' Size FoundSheet to match SheetName. Array elements initialised to False 
    ReDim FoundSheet(LBound(SheetName) To UBound(SheetName)) 

    FoundSheetsCount = 0 
    NotFoundSheetsCount = 0 
    With WbookTgt 
    For InxName = LBound(SheetName) To UBound(SheetName) 
     NotFoundSheetsCount = NotFoundSheetsCount + 1 ' Assume not found until found 
     For InxWsheet = 1 To .Worksheets.Count 
     If SheetName(InxName) = .Worksheets(InxWsheet).Name Then 
      FoundSheet(InxName) = True 
      FoundSheetsCount = FoundSheetsCount + 1 
      NotFoundSheetsCount = NotFoundSheetsCount - 1 
      Exit For 
     End If 
     Next 
    Next 
    End With 

    If NotFoundSheetsCount = 0 Then 
    CheckWorksheets = True 
    Exit Function 
    End If 

    SheetNamesFound = "" 
    ErrorMsg = WbookTgt.Path & "\" & WbookTgt.Name & " does not contain " 
    If NotFoundSheetsCount = 1 Then 
    ErrorMsg = ErrorMsg & "this expected worksheet:" 
    Else 
    ErrorMsg = ErrorMsg & "these expected worksheets:" 
    End If 
    For InxName = LBound(SheetName) To UBound(SheetName) 
    If Not FoundSheet(InxName) Then 
     ErrorMsg = ErrorMsg & vbLf & " " & SheetName(InxName) 
    Else 
     SheetNamesFound = SheetNamesFound & vbLf & " " & SheetName(InxName) 
    End If 
    Next 
    If FoundSheetsCount = 0 Then 
    ' No need to add list of found sheet names 
    Else 
    ErrorMsg = ErrorMsg & vbLf & "but does contain " 
    If FoundSheetsCount = 1 Then 
     ErrorMsg = ErrorMsg & "this expected worksheet:" 
    Else 
     ErrorMsg = ErrorMsg & "these expected worksheets:" 
    End If 
    ErrorMsg = ErrorMsg & SheetNamesFound 
    End If 
    With WbookError 
    With .Worksheets("Errors") 
     RowErrorNext = .Cells(Rows.Count, "A").End(xlUp).Row + 1 
     With .Cells(RowErrorNext, "A") 
     .Value = Now() 
     .VerticalAlignment = xlTop 
     End With 
     .Cells(RowErrorNext, "B").Value = ErrorMsg 
    End With 
    End With 
    CheckWorksheets = False 

End Function 
Function OpenWorkbook(ByVal Path As String, ByVal FileTemplate As String, _ 
         ByRef WbookError As Workbook) As Workbook 

    ' * If Path & FileTemplate identifies a single workbook, open it and return 
    ' it as an object. If Path & FileTemplate does not represent a single 
    ' workbook, report the problem in worksheet Errors and return Nothing. 

    ' * WbookError identifies the workbook containing worksheet "Error". 
    ' * Path must be the name of the folder in which the required workbook is located 
    ' * FileTemplate can either be a specific filename or can contain wild cards 
    ' providing only one file matches the template. 
    ' * WbookError identifies the workbook containing worksheet "Error" to which any 
    ' error message will be added. 

    Dim ErrorMsg As String 
    Dim FileNameCrnt As String 
    Dim FileNameMatch As String 
    Dim RowErrorNext As Long 

    FileNameMatch = Dir$(Path & "\" & FileTemplate, vbNormal) 
    If FileNameMatch = "" Then 
    ' No matches found 
    ErrorMsg = "Template " & Path & "\" & FileTemplate & " does not match any file" 
    Else 
    ' At least one match. 
    ' If only one match, its name is in FileNameMatch 
    Do While True 
     FileNameCrnt = Dir$ 
     If FileNameCrnt = "" Then 
     ' No more matches 
     Exit Do 
     End If 
     ' A second or subsequent match has been found. 
     If FileNameMatch <> "" Then 
     ' This is the second match. 
     ' Initialise error message and report name of first match 
     ErrorMsg = "Template " & Path & "\" & FileTemplate & " matches more than one file:" & _ 
        vbLf & " " & FileNameMatch 
     FileNameMatch = ""  ' No single match 
     End If 
     ' Add name of current match to error message 
     ErrorMsg = ErrorMsg & vbLf & " " & FileNameCrnt 
    Loop 
    End If 

    If FileNameMatch = "" Then 
    ' No single match found. 
    ' ErrorMsg contains an appropriate error message 
    With WbookError 
     With .Worksheets("Errors") 
     RowErrorNext = .Cells(Rows.Count, "A").End(xlUp).Row + 1 
     With .Cells(RowErrorNext, "A") 
      .Value = Now() 
      .VerticalAlignment = xlTop 
     End With 
     .Cells(RowErrorNext, "B").Value = ErrorMsg 
     Set OpenWorkbook = Nothing 
     End With 
    End With 
    Else 
    ' Single match found 
    Set OpenWorkbook = Workbooks.Open(Path & "\" & FileNameMatch) 
    End If 

End Function 

應對額外的問題更快

VBA有什麼能問題就像VB的Try一樣方便，但是它在程序員控制下確實有一些錯誤處理。

如果您使用命令如：

Worksheets("Sheet2").Delete 

用戶將被要求確認刪除。爲了避免這種情況，使用方法：

Application.DisplayAlerts = False 
Worksheets("Sheet2").Delete 
Application.DisplayAlerts = True 

我曾在一個宏，這意味着任何警報將顯示，即使pogrammer沒想到它的用戶的關注開始看到有Application.DisplayAlerts = False代碼。通過包圍Delete，我確保只有我期望的警報被抑制。

考慮：

Sub OpenFile() 
    Dim InputFileNum As Long 
    InputFileNum = FreeFile 
    Open "Dummy.txt" For Input As InputFileNum 
    Debug.Print "File successfully opened" 
    Close InputFileNum 
End Sub 

文件 「Dummy.txt」 不存在這樣的宏將停止在Open聲明。

有時你會看到這樣的代碼：

Sub OpenFile() 

    Dim InputFileNum As Long 

    On Error GoTo ErrorCode 

    InputFileNum = FreeFile 
    Open "Dummy.txt" For Input As InputFileNum 
    Call MsgBox("File successfully opened", vbOKOnly) 
    Close InputFileNum 
    Exit Sub 

ErrorCode: 
    Debug.Print "Unexpected error: " & Err.Number & " " & Err.Description 

End Sub 

這裏我提供了一個一般的處理程序可能發生的任何錯誤情況。我不贊成，儘管我接受這比稍微讓非技術用戶看到突出顯示的錯誤陳述更好。問題是任何錯誤都會導致相同的無用錯誤消息。

我從不在開發過程中包含錯誤處理。如果發生錯誤，我希望宏停止在錯誤的語句，所以我可以考慮如何避免錯誤。在這裏，我應該在試圖打開它之前檢查文件是否存在。我更喜歡這樣的事情：

Sub OpenFile() 

    Dim FileSysObj As Object 
    Dim InputFileNum As Long 

    On Error GoTo ErrorCode 

    Set FileSysObj = CreateObject("Scripting.FileSystemObject") 

    If Not FileSysObj.FileExists("Dummy.txt") Then 
    Call MsgBox("I am unable to find ""Dummy.txt"". List of helpful suggestions.", vbOKOnly) 
    Exit Sub 
    End If 

    InputFileNum = FreeFile 
    Open "Dummy.txt" For Input As InputFileNum 
    Call MsgBox("File successfully opened", vbOKOnly) 
    Close InputFileNum 
    Exit Sub 

ErrorCode: 
    Debug.Print "Unexpected error: " & Err.Number & " " & Err.Description 

End Sub 

我已經包括檢查代碼爲我期望的錯誤。如果該文件不存在，我已經顯示了一條消息，希望能夠幫助用戶解決問題。

有時你無法避免一個錯誤。爲了測試下面的代碼，我創建了文件Dummy.txt，但設置了「讀訪問被拒絕」標誌。 （據我所知），VBA宏測試這個標誌並不容易。我有一個處理意外錯誤的通用處理程序，但是我將它關閉以用於Open聲明，以便我可以包含打開失敗的特定代碼。我已經刪除了使用FileExists()來測試Dummy.txt是否存在的代碼，因爲將其與其他打開的文件錯誤測試結合使用會更容易。

Sub OpenFile() 

    Dim FileSysObj As Object 
    Dim InputFileNum As Long 

    On Error GoTo ErrorCode  ' General handler for unexpected errors 

    InputFileNum = FreeFile 
    Err.Clear 
    On Error Resume Next   ' Record error in Err object and continue 
    Open "Dummy.txt" For Input As InputFileNum 
    Select Case Err.Number 
    Case 0 
     ' No error. 
    Case 53   ' File does not exist 
     Call MsgBox("I am unable to find ""Dummy.txt"". List of helpful suggestions.", vbOKOnly) 
     Exit Sub 
    Case 75   ' Path/File access error 
     Call MsgBox("It appears file ""Dummy.txt"" exists but I do not have permission to read it.", vbOKOnly) 
     Exit Sub 
    Case Else 
     Call MsgBox("My attempt to open ""Dummy.txt"" failed with an unexpected error condition" & vbLf & _ 
        " " & Err.Number & " " & Err.Description, vbOKOnly) 
     Exit Sub 
    End Select 

    On Error GoTo ErrorCode  ' Restore general handler for unexpected errors 

    Call MsgBox("File successfully opened", vbOKOnly) 
    Close InputFileNum 
    Exit Sub 

ErrorCode: 
    Debug.Print "Unexpected error: " & Err.Number & " " & Err.Description 

End Sub 

的錯誤代碼和錯誤處理更多信息的長列表，請訪問http://support.microsoft.com/kb/146864。