Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
381 views
in Technique[技术] by (71.8m points)

excel - How to fix runtime error related to copying vba array into word doc table

I am currently trying to copy an array into a table in a word doc, but I keep getting runtime error 5948 ("The requested member of the collection does not exist.") on the first call of doc.Tables(1).Columns(i).Cells(f).Select and I am unsure of how to solve this. The loop which is supposed to write into the word table fails on i = 0.

EDIT: Added in the full code as well as a screenshot of my table.

Sub makeReport(lNum As Long, pDay As Date, name As String)
    'Template Path: \COREMiscellaneousQualitySample ReportsTemplateDefect Report.dotm
    'Save path for finished report: \COREMiscellaneousQualitySample 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:=("\COREMiscellaneousQualitySample ReportsTemplateDefect Report.dotm"), NewTemplate:=False, DocumentType:=0)
    doc.SaveAs2 Filename:="\COREMiscellaneousQualitySample 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:="\COREMiscellaneousQualitySample 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

Table I copy data into.


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)
等待大神答复

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

2.1m questions

2.1m answers

60 comments

56.6k users

...