如何调用有参数的子程序？

Posted 2023-04-19

【中文标题】如何调用有参数的子程序？

【英文标题】：How to call a subroutine that has parameters?

【发布时间】：2020-12-31 18:31:25

【问题描述】：

我正在使用 Excel 用户表单来为给定日期输入的批次生成报告。

报告存储在 Word 文档中，其中包含 1 到 8 个质量样本的结果（样本数量因批次而异）。

用户表单旨在加载到 Excel 中，从用户那里接收批号和日期，从 Excel 工作簿中的不同工作表中检索当天的样品和批号，然后将数据复制到基于自定义模板。

Userform的输入部分和Word模板都设置好了。我在“确定”按钮的事件处理过程中遇到了障碍。

表单的 OK 按钮事件处理程序给出

编译错误

开

Sub makeReport(lNum As Integer, pDay As Date)

编辑器在我的makeReport 方法中没有指出问题；事件处理程序中对makeReport 的调用以红色突出显示。

我正在使用 Excel 2013 VBA 编辑器，Excel 中的内置调试工具、Microsoft 在线 VBA 文档以及通过 Google 找到的各种论坛帖子都不能给我一个完整的答案，告诉我什么是错误的以及如何修复它.

确定按钮事件处理程序

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

【问题讨论】：

编译错误信息是什么意思？代码对我来说看起来不错，但我会尝试将 makeReport 更改为函数并将 Byref 参数添加到两个传递的变量中......只是为了笑。

【参考方案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")

【讨论】：

效果如您所愿，感谢您的帮助。