Hallo Profis,
ich hänge gerade mit einem Code an einer bestimmten Stelle... Ich möchte das ein geöffnetes Word Dokument in einem zusammengestellten Pfad mit einem zusammengetellten Namen gespeichert wird ohne das Speichern unter auftaucht...
Mit diesem Code erreiche ich allerdings nur, dass das Speichern Dialog aufgerufen wird:
' Word Speicherdialog aufrufen
Set objDialog = objApp.Dialogs(wdDialogFileSaveAs)
With objDialog
' Pfad vorgeben
.Name = "C:\Users\afetinci\Desktop\MAKROTEST\" & Sheets("Eintritte").Cells(Selection.Row, 15).Value & "\" & Sheets("Eintritte").Cells(Selection.Row, 16).Value & "\" & Sheets("Eintritte").Cells(Selection.Row, 4).Value & "\" & Sheets("Eintritte").Cells(Selection.Row, 5).Value & "\"
' Wenn auf Speichern geklickt wurde...
If .Display = -1 Then
objDocument.SaveAs Filename:=Sheets("Eintritte").Cells(Selection.Row, 4).Value & " " & Sheets("Eintritte").Cells(Selection.Row, 5).Value
End If
' Dokument schliessen
objDocument.Close
End With
End With
Kann mir jemand weiterhelfen.
Grüße
Der ganze Code:
Option Explicit
' Namen der Textmarken im Worddokument
Const strBookmark1 As String = "NiederlassungKopfzeile"
Const strBookmark2 As String = "AnredeBK"
Const strBookmark3 As String = "VornameBK"
Const strBookmark4 As String = "NameBK"
Const strBookmark5 As String = "StraßeBK"
Const strBookmark6 As String = "PLZBK"
Const strBookmark7 As String = "OrtBK"
Const strBookmark8 As String = "EINTRITT"
Const strBookmark9 As String = "NiederlassungVertrag"
Const strBookmark10 As String = "GEHALT"
Const strBookmark11 As String = "VornameUS"
Const strBookmark12 As String = "NachnameUS"
' Konstante für den Speichern-Unter Dialog in Word
Const wdDialogFileSaveAs = 84
' Wenn Word nicht offen ist wird diese Variable auf True
' gesetzt und Word am Ende wieder geschlossen
' War Word schon offen, belibt es das auch
Dim blnTMP As Boolean
'--------------------------------------------------------------------------
' Module : Modul1
' Procedure : Main
' Author : Case (Ralf Stolzenburg)
' Date : 26.10.2012
' Purpose : Daten von Excel nach Word in Textmarken (Bookmarks)...
'--------------------------------------------------------------------------
Public Sub Main()
' Variablendeklaration
' Da wir mit Late Binding arbeiten, also ohen Verweise auf die
' Wordbibliothek dimensionieren wir die Wordbezogenen Variablen
' als Objekt, die dann mit Set dem entsprechenden
' Objekt zugewiesen werden
Dim objWordRange As Object
Dim objDocument As Object
Dim objDialog As Object
Dim objApp As Object
Dim strDoc As String
' Bei einem Fehler gehe zu diesrr Sprungmarke
On Error GoTo Fin
' Das Worddokument mit Pfad und Name
strDoc = Sheets("Eintritte").Cells(Selection.Row, 17).Value
' Die Wordapplikation wird mit der Funktion "OffApp" gesucht
' ODER bei Bedarf gestartet
Set objApp = OffApp("Word")
'folgende Codezeile für Word nicht sichtbar
'Set objApp = OffApp("Word", False)
' Wenn die Word der Objektvariablen zugewiesen werden konnte dann...
If Not objApp Is Nothing Then
' Öffne das Worddokument, zugewiesen an die Objektvariable objDocument
Set objDocument = objApp.Documents.Open(Filename:=strDoc)
' With für Schreibfaule :-) Alle Bezüge auf Tabelle1 müssen
' mit einem Punkt beginnen
With ThisWorkbook.Worksheets("Eintritte")
' Prüfe, ob die Textmarke vorhanden ist
If objDocument.Bookmarks.Exists(strBookmark1) = True Then
' Schreibe den Wert von B2 in die Textmarke Name
objDocument.Bookmarks(strBookmark1).Range.Text = .Cells(Selection.Row, 15).Value
End If
If objDocument.Bookmarks.Exists(strBookmark2) = True Then
objDocument.Bookmarks(strBookmark2).Range.Text = .Cells(Selection.Row, 39).Value
End If
If objDocument.Bookmarks.Exists(strBookmark3) = True Then
objDocument.Bookmarks(strBookmark3).Range.Text = .Cells(Selection.Row, 5).Value
End If
If objDocument.Bookmarks.Exists(strBookmark4) = True Then
objDocument.Bookmarks(strBookmark4).Range.Text = .Cells(Selection.Row, 4).Value
End If
If objDocument.Bookmarks.Exists(strBookmark5) = True Then
objDocument.Bookmarks(strBookmark5).Range.Text = .Cells(Selection.Row, 6).Value
End If
If objDocument.Bookmarks.Exists(strBookmark6) = True Then
objDocument.Bookmarks(strBookmark6).Range.Text = .Cells(Selection.Row, 7).Value
End If
If objDocument.Bookmarks.Exists(strBookmark7) = True Then
objDocument.Bookmarks(strBookmark7).Range.Text = .Cells(Selection.Row, 8).Value
End If
If objDocument.Bookmarks.Exists(strBookmark8) = True Then
objDocument.Bookmarks(strBookmark8).Range.Text = .Cells(Selection.Row, 11).Value
End If
If objDocument.Bookmarks.Exists(strBookmark9) = True Then
objDocument.Bookmarks(strBookmark9).Range.Text = .Cells(Selection.Row, 15).Value
End If
If objDocument.Bookmarks.Exists(strBookmark10) = True Then
objDocument.Bookmarks(strBookmark10).Range.Text = .Cells(Selection.Row, 21).Value
End If
If objDocument.Bookmarks.Exists(strBookmark11) = True Then
objDocument.Bookmarks(strBookmark11).Range.Text = .Cells(Selection.Row, 5).Value
End If
If objDocument.Bookmarks.Exists(strBookmark12) = True Then
objDocument.Bookmarks(strBookmark12).Range.Text = .Cells(Selection.Row, 4).Value
End If
' Word Speicherdialog aufrufen
Set objDialog = objApp.Dialogs(wdDialogFileSaveAs)
With objDialog
' Pfad vorgeben
.Name = "C:\Temp\"
' Wenn auf Speichern geklickt wurde...
If .Display = -1 Then
objDocument.SaveAs Filename:=.Name
End If
' Dokument schliessen
objDocument.Close
End With
End With
Else
' Ausgabe, wenn die Objektvariable objApp Nothing ist...
MsgBox "Applikation nicht installiert!"
End If
Fin:
If Not objApp Is Nothing Then
' Wor war nicht offen, also...
If blnTMP = True Then
' ... Word schliessen
objApp.Quit
blnTMP = False
End If
End If
' Objektvariablen leeren
Set objWordRange = Nothing
Set objDocument = Nothing
Set objApp = Nothing
Application.CutCopyMode = True
' Wenn die Fehlernummer NICHT 0 ist, dann gib die Fehlernummer
