Generieren eines Microsoft Word-Berichts von Excel-Anwendung Warten auf OLE-Aktion? (VBA)

Question

Ich versuche, ein Makro zu schreiben, das einen Microsoft Word-Bericht aus einer Excel-Datei generiert. Ich möchte, dass das Makro zu Lesezeichen in einer Word-Vorlage für den Bericht navigiert und bei jedem bestimmten Inhalt oder einem Diagramm aus der nativen Excel-Datei eingefügt wird. Das Makro funktioniert, wenn es stückweise ausgeführt wird, aber insgesamt nicht ausgeführt werden kann, wobei sich Excel immer wieder wiederholt. "[Es] wartet darauf, dass eine andere Anwendung eine OLE-Aktion ausführt."

Um dies ebenfalls zu verdeutlichen, löscht das Makro zuerst einen bestimmten 'data dump'-Bereich in der Arbeitsmappe (seine native Datei) und füllt ihn mit neuen Daten aus einer angegebenen Datei auf. Diese Datei (ihr Speicherortpfad) und die verschiedenen Variablen 'Zielzeile' und 'Bezeichner', die Sie im Code sehen, werden vom Benutzer in eine Art Schnittstelle eingegeben (nur ein Arbeitsblatt in der nativen Arbeitsmappe) Ein (benannter) Bereich, in den leicht eingegeben werden kann, um von dem Code verwendet zu werden. Das Makro erstellt dann den Bericht, indem es die verschiedenen Arbeitsblätter der Arbeitsmappe durchgeht, bestimmte Inhalte kopiert und zu Word wechselt, um den kopierten Inhalt an Vorlagenpositionen einzufügen, die durch Lesezeichen gekennzeichnet sind.

Ich bin völlig perplex durch den 'OLE-Fehler'. Irgendwelche Ideen zu diesem/dem Code sonst? Bitte teilen. Danke für Ihre Hilfe!

Sub GenerateReport() 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
Application.EnableEvents = False 
Application.Calculation = xlCalculationManual 

Dim myWorkbook As Excel.Workbook 
Set myWorkbook = ThisWorkbook 
Dim myWorksheet As Excel.Worksheet 
Set myWorksheet = myWorkbook.Sheets("Sheet1") 
Dim myWorksheet2 As Excel.Worksheet 
Set myWorksheet2 = myWorkbook.Sheets("Sheet2") 
Dim myWorksheet3 As Excel.Worksheet 
Set myWorksheet3 = myWorkbook.Sheets("Sheet3") 

Dim FileName As String 
FileName = myWorksheet.Range("FileName") 
Dim FilePath As String 
FilePath = myWorksheet.Range("FilePath") 
Dim TargetSheetName As String 
TargetSheetName = myWorksheet.Range("TargetSheetName") 
Dim PasteSheetName As String 
PasteSheetName = myWorksheet.Range("PasteSheetName") 

Dim Identifier As String 
Identifier = myWorksheet.Range("Identifier") 
Dim Identifier2 As String 
Identifier2 = myWorksheet.Range("Identifier2") 
Dim TargetRow As String 
TargetRow = myWorksheet.Range("TargetRow") 
Dim TargetRow2 As String 
TargetRow2 = myWorksheet.Range("TargetRow2") 
Dim PasteIdentifier As String 
PasteIdentifier = myWorksheet.Range("PasteIdentifier") 
Dim PasteIdentifier2 As String 
PasteIdentifier2 = myWorksheet.Range("PasteIdentifier2") 
Dim PasteTargetRow As String 
PasteTargetRow = myWorksheet.Range("PasteTargetRow") 
Dim PasteTargetRow2 As String 
PasteTargetRow2 = myWorksheet.Range("PasteTargetRow2") 

Dim Text As String 
Text = myWorksheet.Range("Text") 
Dim Text2 As String 
Text2 = myWorksheet.Range("Text2") 
Dim Text3 As String 
Text3 = myWorksheet.Range("Text3") 

Dim ReportTemplateFilePath As String 
ReportTemplateFilePath = myWorksheet.Range("ReportTemplateFilePath") 
Dim ReportTemplateFileName As String 
ReportTemplateFileName = myWorksheet.Range("ReportTemplateFileName") 
Dim SaveToLocation As String 
SaveToLocation = myWorksheet.Range("SaveToLocation") 

Dim SourceTargetSheet As Excel.Worksheet 
Set SourceTargetSheet = myWorkbook.Sheets(PasteSheetName) 
Dim TargetWorkbook As Excel.Workbook 
Set TargetWorkbook = Workbooks.Open(FilePath) 
Dim TargetSheet As Excel.Worksheet 
Set TargetSheet = TargetWorkbook.Sheets(TargetSheetName) 

'Clear old info 
Dim UpperLeftHandCornerOfClear As String 
UpperLeftHandCornerOfClear = "A" & PasteTargetRow 
Dim LowerRightHandCornerOfClear As String 
LowerRightHandCornerOfClear = "XFD" & PasteTargetRow2 
SourceTargetSheet.Range(UpperLeftHandCornerOfClear, LowerRightHandCornerOfClear).ClearContents 

'Copy new info for pasting 
Dim StartingColumnAsRange As Range 
Set StartingColumnAsRange = TargetSheet.Cells.Find(Identifier, LookIn:=xlValues, LookAt:=xlPart) 
If Not StartingColumnAsRange Is Nothing Then 
    Dim StartingColumn As String 
    StartingColumn = Split(StartingColumnAsRange.Address, "$")(1) 
End If 
Dim EndingColumnAsRange As Range 
Set EndingColumnAsRange = TargetSheet.Cells.Find(Identifier2, LookIn:=xlValues, LookAt:=xlPart) 
If Not EndingColumnAsRange Is Nothing Then 
    Dim EndingColumn As String 
    EndingColumn = Split(EndingColumnAsRange.Address, "$")(1) 
End If 
Dim UpperLeftHandCornerOfCopy As String 
UpperLeftHandCornerOfCopy = StartingColumn & TargetRow 
Dim LowerRightHandCornerOfCopy As String 
LowerRightHandCornerOfCopy = EndingColumn & TargetRow2 
TargetSheet.Range(UpperLeftHandCornerOfCopy, LowerRightHandCornerOfCopy).Copy 
Dim PastePasteTarget As String 
PastePasteTarget = "A" & PasteTargetRow 
SourceTargetSheet.Range(PastePasteTarget).PasteSpecial Paste:=xlPasteValues 

'Create a Microsoft Word object (instance of Word to control) 
Dim WordApplication As Word.Application 
Set WordApplication = CreateObject("Word.Application") 

'Error handle if Microsoft Word is open 
On Error Resume Next 
    Set WordApplication = GetObject(class:="Word.Application") 
    Err.Clear 
    If WordApplication Is Nothing Then 
     Set WordApplication = CreateObject(class:="Word.Application") 
    End If 
On Error GoTo 0 

'Error handle if report template is specifically already open 
On Error Resume Next 
Application.DisplayAlerts = False 
Documents(ReportTemplateFileName).Close SaveChanges:=wdDoNotSaveChanges 
On Error GoTo 0 
Application.DisplayAlerts = True 

Dim WordDocument As Word.Document 
Set WordDocument = WordApplication.Documents.Open(ReportTemplateFilePath) 

'Content from 'myWorksheet' 
With WordDocument 
    .Bookmarks("Bookmark1").Range.Text = myWorksheet.Range("Text1") 
    .Bookmarks("Bookmark2").Range.Text = myWorksheet.Range("Text2") 
    .Bookmarks("Bookmark3").Range.Text = myWorksheet.Range("Text3") 
    .Bookmarks("Bookmark4").Range.Text = myWorksheet.Range("Text4") 
End With 

'Content from 'myWorksheet2' 
With WordDocument 
    .Bookmarks("Bookmark5").Range.Text = myWorksheet2.Range("Text5") 
    .Bookmarks("Bookmark6").Range.Text = myWorksheet2.Range("Text6") 
    .Bookmarks("Bookmark7").Range.Text = myWorksheet2.Range("Text7") 
    .Bookmarks("Bookmark8").Range.Text = myWorksheet2.Range("Text8") 
    .Bookmarks("Bookmark9").Range.Text = myWorksheet2.Range("Text9") 
    .Bookmarks("Bookmark10").Range.Text = myWorksheet3.Range("Text10") 
End With 

'Chart (alone on worksheet) 
WordApplication.Selection.Goto What:=wdGoToBookmark, Name:="Chart1" 
ThisWorkbook.Sheets("Chart 1 Worksheet Name").ChartObjects(1).Copy 
WordApplication.Selection.Paste 
WordApplication.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter 

'Two charts grouped together 
WordApplication.Selection.Goto What:=wdGoToBookmark, Name:="Chart2" 
ThisWorkbook.Sheets("Chart 2 Worksheet Name").ChartObjects(1).Copy 
WordApplication.Selection.Paste 
WordApplication.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter 

With WordDocument 
    .SaveAs FileName:=SaveToLocation & " " & Text3, _ 
      FileFormat:=wdFormatDocumentDefault 
    .Close 
End With 

WordApplication.Quit 
Set WordApplication = Nothing 
Set WordDocument = Nothing 

Application.ScreenUpdating = True 
'Application.DisplayAlerts = True 
Application.EnableEvents = True 
Application.Calculation = xlCalculationAutomatic 

myWorksheet.Activate 
MsgBox "Report successfully generated.", vbInformation, "Completed!" 

End Sub 

Answer 1

Versuchen Sie, Ihre Word-Anwendung Erstellungsskript zu modifizieren - das ist alles, was Sie brauchen:

On Error Resume Next 
Set WordApplication = GetObject(class:="Word.Application") 
On Error GoTo 0 

If WordApplication Is Nothing Then 
    Set WordApplication = CreateObject(class:="Word.Application") 
End If 

Es kann sein, dass Word für einige Eingaben von Ihnen erwartet, aber Sie sehen es nicht, weil Sie didn Machen Sie die Instanz nicht sichtbar. Versuchen Sie auch, Folgendes hinzuzufügen: