使用VBA将Excel数据导入现有的Word文档

我目前有问题,每次即时通讯试图打开Word文档通过VBA / Excel的即时通讯获取应用程序/对象错误。 我的想法是,即时通讯试图比较两个表中的数据,并删除不好的结果。 之后,我想插入整个表到现有的文件文件什么即时通讯select/打开窗口中select。

我的代码

Private Sub CommandButton1_Click() Dim varDatei As Variant Dim wordDatei As Variant Dim objExcel As New Excel.Application Dim objSheet As Object Dim wordDoc As Object Dim extBereich As Variant Dim intBereich As Variant Dim appWord As Object Set intBereich = ThisWorkbook.Sheets(1).Range("A4:A11") Dim loopStr As Variant Dim loopStr2 As Variant Dim found() As Variant Dim loopInt As Integer Dim endStr As Variant Dim extBereich2 As Variant loopInt = 1 varDatei = Application.GetOpenFilename("Excel-Dateien (*.xlsx), *.xlsx") If varDatei <> False Then objExcel.Workbooks.Open varDatei Set objSheets = objExcel.Sheets(1) objSheets.Activate LetzteZeile = objSheets.Cells(objSheets.Rows.Count, 3).End(xlUp).Row Set extBereich = objSheets.Range("B3:B" & LetzteZeile) ReDim found(1 To LetzteZeile) For Each loopStr In extBereich objSheets.Range("F" & loopStr.Row) = "Good" objSheets.Cells(loopStr.Row, 6).Interior.ColorIndex = 4 For Each loopStr2 In intBereich If (StrComp(loopStr, loopStr2, vbBinaryCompare) = 0) = True Then found(loopInt) = objSheets.Range("A" & loopStr.Row) loopInt = loopInt + 1 objSheets.Cells(loopStr.Row, 6) = "Bad" objSheets.Cells(loopStr.Row, 6).Interior.ColorIndex = 3 Exit For End If Next loopStr2 Next loopStr loopStr = "" If (loopInt <> 1) Then endStr = "This is bad:" & vbLf For Each loopStr In found If (Trim(loopStr & vbNullString) <> vbNullString) Then endStr = endStr & loopStr & vbLf End If Next loopStr MsgBox (endStr) Else MsgBox ("Everythings good") End If Set appWord = CreateObject("Word.Application") appWord.DisplayAlerts = False Debug.Print ("123") Set wordDoc = appWord.Documents.Open(Application.GetOpenFilename("Word-Dateien (*.doc;*.docx;),*.doc;*.docx")) wordDoc.Activate Debug.Print ("456") loopStr = "" For Each loopStr In extBereich If (objSheets.Cells(loopStr.Row, 6).Interior.ColorIndex = 3) Then objSheets.Range("A" & loopStr.Row & ":" & "E" & loopStr.Row).Delete End If Next loopStr objSheets.Range(Columns(2), Columns(4)).Delete objSheets.Range("A3:B" & LetzteZeile).Copy appWord.Documents(1).Range.Paste With appWord.Documents(1).Tables(1) .Columns.AutoFit End With appWord.PrintOut objExcel.Quit appWord.Quit Set appWord = Nothing Set objExcel = Nothing Debug.Print loopInt Else MsgBox "Error" End If End Sub 

也许你们中有人知道这个问题是什么?

错误代码是1004 – 应用程序或对象错误

以最好的问候和谢谢回答

你的问题是与行:

 objSheets.Range(Columns(2), Columns(4)).Delete 

你需要指定列的位置,例如

 objSheets.Range(objSheets.Columns(2), objSheets.Columns(4)).Delete