Versuch mal Excel und Word zu trennen, also er kopieren und dann den Word Teil. Vielleicht hilft das. Mir ist nicht ganz klar warum du das in der Reihenfolge ausführst...
Ändert sich so etwas?
Option Explicit
Sub Copy2Word()
Application.ScreenUpdating = False
Call CheckPath(s_Path)
'If n_CellsCounter = 1 And n_Zellenposition = 1 Then
If b_WordDone = False Then
b_WordDone = True
Set app_word = CreateObject("word.application").Documents.Add(Worksheets("Parameter").Range("PAR_Template").Text).Application
With app_word.ActiveDocument
'Eingabedaten in das Production Sheet übernehmen
.CustomDocumentProperties("D") = frm_Insert.txt_D.Text
.CustomDocumentProperties("N") = frm_Insert.cbo_N.Text
.CustomDocumentProperties("P") = frm_Insert.cbo_O.Text
.CustomDocumentProperties("A") = frm_Insert.cbo_A.Text
.CustomDocumentProperties("S") = s_FileName
.CustomDocumentProperties("T") = frm_Insert.cbo_T.Text
.CustomDocumentProperties("Date") = Date
.CustomDocumentProperties("E") = frm_Insert.cbo_E.Text
.CustomDocumentProperties("Z") = frm_Insert.cbo_Z.Text
.CustomDocumentProperties("Te") = frm_Insert.txt_Te.Text
.CustomDocumentProperties("In") = frm_Insert.cbo_In.Text
.CustomDocumentProperties("Ku") = frm_Insert.cbo_Ku.Text
.CustomDocumentProperties("Po") = frm_Insert.cbo_Po.Text
.CustomDocumentProperties("Dru") = frm_Insert.txt_Dru.Text
.CustomDocumentProperties("Dr") = frm_Insert.txt_Dr.Text
'Dokument zum ersten Mal abspeichern
.SaveAs Filename:=s_Path & s_FileName, FileFormat:=wdFormatDocument
End With
End If
Sheets("Diagramme").Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:= _
xlPicture
With app_word.Selection
'name als Überschrift einfügen, Diagramme kopieren und anhängen
.Move unit:=wdStory, Count:=1
.InsertBreak Type:=wdPageBreak
.Style = .ActiveDocument.Styles("Überschrift 1")
.TypeText Text:=frm_InsertSolarCell.txt_Serie.Text & "_" & frm_InsertSolarCell.cbo_Device.Text & "_" & s_Zellenposition
.TypeParagraph
.TypeText Text:=frm_InsertSolarCell.txt_Kommentar.Text
.TypeParagraph
'.Selection.MoveDown unit:=wdLine 'stattdessen Enter eintragen
.Paste
End With
ActiveSheet.ChartObjects("Chart 2").Activate
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:= _
xlPicture
With app_word.Selection
.TypeParagraph
'.Selection.MoveDown unit:=wdLine 'stattdessen Enter eintragen
.Paste
End With
Sheets("So").Select
Cells(n_LastRowNr, Range("SC_Filename").Column).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=s_Path & s_FileName & ".doc", TextToDisplay:= _
s_FileName
'Application.ScreenUpdating = False
End Sub
Und guck mal bei deinem Freund, ob unter VBA/Extras/Verweise irgendwelche Bibilotheken "NICHT VORHANDEN" drinnen sind, wenn ja nimm da mal den Haken raus und versuchs nochmal...
|