[英]How to call a subroutine that has parameters?
我正在使用 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
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")
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.