使用VBA将Excel数据实现到现有Word文档中

时间:2016-01-20 11:20:39

标签: excel vba excel-vba

我目前遇到的问题是每次尝试通过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 - 应用程序或对象错误

致以最诚挚的问候和感谢回答

1 个答案:

答案 0 :(得分:1)

你的问题在于:

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

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

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