我目前遇到的问题是每次尝试通过vba / excel打开word文档时都会遇到应用程序/对象错误。我的想法是,我试图比较两个表中的数据并删除不良结果。之后我想将整个表格插入到现有的word文档中,从选择/打开窗口中选择什么。
我的代码
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 - 应用程序或对象错误
致以最诚挚的问候和感谢回答
答案 0 :(得分:1)
你的问题在于:
objSheets.Range(Columns(2), Columns(4)).Delete
您需要指定列的位置,例如
objSheets.Range(objSheets.Columns(2), objSheets.Columns(4)).Delete