我目前正在尝试将数组复制到 word 文档中的表中,但在第一次调用 doc.Tables(1).Columns(i).Cells(f).Select
时,我不断收到运行时错误 5948(“请求的集合成员不存在。”)我不确定如何解决这个问题。应该写入单词表的循环在 i = 0 时失败。
编辑:添加了完整代码以及我的表格的屏幕截图。
Sub makeReport(lNum As Long, pDay As Date, name As String)
'Template Path: \\CORE\Miscellaneous\Quality\Sample Reports\Template\Defect Report.dotm
'Save path for finished report: \\CORE\Miscellaneous\Quality\Sample Reports
'Initialize word objects and open word
Dim obj As Word.Application
Dim doc As Word.Document
Dim wdCell As Word.Cell
'MsgBox ("Word Doc Opened")
Set obj = New Word.Application
obj.Visible = True
Set doc = obj.Documents.Add(Template:=("\\CORE\Miscellaneous\Quality\Sample Reports\Template\Defect Report.dotm"), NewTemplate:=False, DocumentType:=0)
doc.SaveAs2 Filename:="\\CORE\Miscellaneous\Quality\Sample Reports\" + name, FileFormat:=wdFormatDocumentDefault, AddtoRecentFiles:=False
'MsgBox ("Word Objects Initialized")
'Fill in lot number and date at top of report
With doc
.Application.Selection.Find.Text = "<<date>>"
.Application.Selection.Find.Execute
.Application.Selection = Format(pDay, "mm/dd/yyyy")
.Application.Selection.EndOf
.Application.Selection.Find.Text = "<<lot>>"
.Application.Selection.Find.Execute
.Application.Selection = lNum
End With
'MsgBox ("Filled in pack date and lot number")
'Initialize excel objects
Dim wBook As Workbook
Dim wFunc As WorksheetFunction
Set wFunc = Application.WorksheetFunction
Set wBook = ThisWorkbook
Worksheets("Defect Table").Activate
Application.ActiveSheet.UsedRange.Select
'MsgBox ("Set Active Sheet to Defect Table")
'Initialize copy control variables
Dim x As Long
Dim y As Long
x = Selection.Rows.count
'MsgBox ("Number of rows: " + CStr(x))
Dim numArray() As Long
Dim dateArray() As Date
Dim hold(0 To 7) As Long
Dim b As Long
Dim msg As String
Dim c As Long
Dim d As Long
Dim e As Long
Dim f As Long
Dim g As Long
Dim i As Long
Dim temp As Variant
Dim sample(0 To 29) As Variant
i = 0
ReDim numArray(2 To x)
ReDim dateArray(2 To x)
For y = 2 To x
'Array which holds all lot numbers
numArray(y) = CInt(Application.ActiveSheet.Cells(y, 3).Value)
'Array which holds all dates
dateArray(y) = CDate(Application.ActiveSheet.Cells(y, 1).Value)
If (lNum = numArray(y) And pDay = dateArray(y)) Then
hold(i) = y
i = i + 1
End If
Next y
msg = "Appropriate samples found." + vbCrLf + "Rows: "
For i = 0 To 7
msg = msg + vbCrLf + CStr(hold(i))
Next i
MsgBox (msg)
'Copies samples over to word doc
For i = 0 To 7
d = hold(i)
If d = 0 Then
b = i
Exit For
End If
For c = 4 To 32
e = c - 4
If e = 30 Then
e = e + 1
c = c + 1
End If
sample(e) = ActiveSheet.Cells(d, c).Value
g = 1
For f = 0 To 32
Select Case f 'Accounts for blanks left in lines 6, 10, 16, 22, 30 of table in word doc
Case 0, 6, 10, 16, 22, 30
g = f + 1
Case Else
g = f
End Select
doc.Tables(1).Columns(i + 1).Cells(g).Select
obj.Selection.TypeText (sample(f))
f = f + 1
g = g + 1
Next f
Next c
If i = b Then
Exit For
End If
Next i
'---MsgBox ("Data copied to Word Doc")
'Saves Document using regular name format for ease of access
'---doc.SaveAs2 Filename:="\\CORE\Miscellaneous\Quality\Sample Reports\" + name, FileFormat:=wdFormatDocumentDefault, AddtoRecentFiles:=False
'Zeroes out word/excel objects
'---Set doc = Nothing
'---Set obj = Nothing
'---Set wBook = Nothing
'---MsgBox ("Report saved and objects zeroed out")
End Sub