如何調用有參數的子程序？

Question

我正在使用 Excel 用戶表單來為給定日期輸入的批次生成報告。

報告存儲在 Word 文檔中，其中包含 1 到 8 個質量樣品的結果（樣品數量因批次而異）。

用戶表單旨在加載 Excel，從用戶那里接收批號和日期，從 Excel 工作簿中的不同工作表中檢索當天的樣品和批次，然后將數據復制到基於自定義模板的新 Word 文檔中。

Userform的輸入部分和Word模板都設置好了。 我在“確定”按鈕的事件處理過程中遇到了障礙。

表單的 OK 按鈕事件處理程序給出

編譯錯誤

上

Sub makeReport(lNum As Integer, pDay As Date)

編輯器沒有在我的makeReport方法中指出問題； 事件處理程序中對makeReport的調用以紅色突出顯示。

I am using the Excel 2013 VBA editor, and neither the built-in debugging tools in Excel, the Microsoft online VBA docs nor various forum posts found via Google can give me a complete answer to what is wrong and how to fix it.

確定按鈕事件處理程序

Private Sub OKButton_Click() 'OK button
    'Declare variables
    Dim lNum As Integer
    Dim pDay As Date
    Dim name As String
    Dim nStr As String
    Dim dStr As String
    
    'Error handler for incorrect input of lot number or pack date
    On Error GoTo ErrorHandler
    
    'Convert input values to correct types
    nStr = TextBox1.Value
    dStr = TextBox2.Value
    
    'Set variable values
    lNum = CInt(nStr)
    
    MsgBox ("Step 1 Done" + vbCrLf + "Lot Number: " + nStr)
    
    pDay = Format(dStr, "mm/dd/yyyy")
    
    MsgBox ("Step 2 Done" + vbCrLf + "Pack Date: " + dStr)
    
    name = nameDoc(pDay, lNum)
    
    MsgBox ("Step 3 Done" + vbCrLf + "Report Name: " + name)
    
    'Check for existing report
    If Dir("\\CORE\Miscellaneous\Quality\Sample Reports\" + name) Then
        MsgBox ("The file " + name + "already exists. Check \\CORE\Miscellaneous\Quality\Sample Reports for the report.")
        Unload UserForm1
        Exit Sub
    Else
        makeReport(lNum, pDay)
    End If
    
    'Unload User Form and clean up
    Unload UserForm1
    Exit Sub
ErrorHandler:
    MsgBox ("Error. Please Try Again.")
    'Unload UserForm1
End Sub

制作報告子

Sub makeReport(lNum As Integer, pDay As Date)
    
    'Template Path: \\CORE\Miscellaneous\Quality\Sample Reports\Template\Defect Report.dotm
    'Save path for finished report: \\CORE\Miscellaneous\Quality\Sample Reports
    'Generate doc name
    
    Dim name As String
    name = nameDoc(pDay, lNum)
    
    'Initialize word objects and open word
    Dim wApp As Word.Application
    Dim wDoc As Word.Document
    
    Set wApp = CreateObject("Word.Application")
    wApp.Visible = True
    Set wDoc = wApp.Documents.Add(Template:=("\\CORE\Miscellaneous\Quality\Sample Reports\Template\Defect Report.dotm"), NewTemplate:=False, DocumentType:=0)
    
    'Initialize excel objects
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets("Defect Table")
    
    'Fill in lot number and date at top of report
    With wDoc
        .Application.Selection.Find.Text = "<<date>>"
        .Application.Selection.Find.Execute
        .Application.Selection = pDay
        .Application.Selection.EndOf
    
        .Application.Selection.Find.Text = "<<lot>>"
        .Application.Selection.Find.Execute
        .Application.Selection = lNum
    End With
    
    'Initialize loop variables
    Dim row1 As Integer
    Dim row2 As Integer
    Dim diff As Integer
    Dim more As Boolean
    Dim num As Integer, num1 As Integer, col As Integer
    Dim count As Integer
    
    count = 0
    diff = 0
    more = False
        
    'Do while loop allows variable number of samples per day
    Do While count < 8
        
        'Checks for correct starting row of day
        row1 = WorksheetFunction.Match(lNum, wsSheet.Range(), 0)
        row2 = WorksheetFunction.Match(pDay, wsSheet.Range(), 0)
        
        If IsError(row1) Or IsError(row2) Then
            'Breaks for loop once all samples have been copied over
            Exit Do
            
        ElseIf row1 = row2 Then
            num = 4
            num1 = num
            Do While num < 31
                'Column variable
                col = count + 1
                
                'Copies data to word doc, accounting for blank rows in the word table
                Select Case num
                    Case 6, 10, 16, 22, 30
                        num1 = num1 + 1
                    Case Else
                        num1 = num1
                End Select
                
                ActiveDocument.Tables(1).Cell(num1, col) = ActiveSheet.Range().Cells(row1, num)
                num = num + 1
            Next
        Else
            'Deiterates count to adjust for differences between row1 and row2
            count = count - 1
        End If
            
        'Moves the collision to below row1 to allow MATCH to find next viable result
        diff = row1 + 1
        wsSheet = wsSheet.Range().Offset(diff, 0)
        
        'Iterates count
        count = count + 1
        
    Loop
    
    'Zeroes out word objects
    Set wdDoc = Nothing
    Set wdApp = Nothing
    
    'Saves Document using regular name format for ease of access
    wDoc.SaveAs2 Filename:="\\CORE\Miscellaneous\Quality\Sample Reports\" + name, FileFormat:=wdFormatDocumentDefault, AddtoRecentFiles:=False
    
End Sub

Answer 1

makeReport(lNum, pDay)

這里的括號意味着您期望返回的東西不會發生，因為makeReport是Sub而不是Function 。 這導致編譯錯誤。 要更正，只需刪除括號。

您還有一個額外的問題，因為pDay不匹配。 格式化日期時，會將其從Date （只是一個數值）轉換為String 。

在OKButton_Click()嘗試更改：

pDay = Format(dStr, "mm/dd/yyyy")

至：

pDay = CDate(dStr)

使其與makeReport預期的數據類型相匹配。 然后，您可以通過更改在makeReport中應用所需的格式

.Application.Selection = pDay

至

.Application.Selection = Format(pDay, "mm/dd/yyyy")