Aus Excel Word-Speichern-Unter-Dialog aufrufen
grossermanitu
ich erstelle aus Excel ein Word-Dokument das im Anschluss den Speichern-Unter-Dialog mit vorgegeben Pfad aufrufen soll. Das ganze funktioniert solange keine anderen Word-Dokumente offen sind.
Wie weiße ich nun zu, dass für das Word-Dokument das gerade erstellt wurde der Speichern-Unter-Dialog geöffnet wird.
Unten stehend der Code. Die relevanten Zeilen befinden sich am Ende. Danke im Voraus.
Option Explicit
Public Function fkt_ReplaceBookmarkText(oDoc As Word.Document, strBMName As String, strBMText _
_
_
_
As String)
'fkt_ReplaceBookmarkText ActiveDocument/ Name des zu bearbeitenden Dokuments, "Name _
Textmarke", "Einzufügender Text"
'Funktion zum Befüllen von Textmarken
'Variblen Deklaration
Dim rng As Word.Range
'Wenn Textmarke "strBMName" existert
If oDoc.Bookmarks.Exists(strBMName) Then
'Merken mittels Range-Objekt den Range-Bereich der Textmarke
Set rng = oDoc.Bookmarks(strBMName).Range
'Erstellt einer neuen Textmarke gleichen Namens um die Grenzen des Range-Objektes
rng.Text = strBMText
'Text der existierende Textmarke "strBMName" durch den Text "strBMText" ersetzt werden.
oDoc.Bookmarks.Add strBMName, rng
Set rng = Nothing
End If
End Function
Sub Arbeitsvertrag_Gehalt()
'Aktualität der Vorlage überprüfen
Dim datum_original As String
Dim datum_vorlage As String
datum_original = FileDateTime("X:\Vorlagen_Leitfäden_Prozessdoku\Verträge\Mitarbeiter\vorlage_angestellte\2_nicht student\gehalt\gehalt_sachl_befristet_name_vorname_av_projektnummer.dot")
datum_vorlage = FileDateTime("C:\Eigene Dateien\Automatisierung\Vorlagen\Original\gehalt_sachl_befristet_name_vorname_av_projektnummer.dot")
If Not datum_original = datum_vorlage Then
MsgBox "Achtung Vertragsvorlage veraltet. Bitte aktualisieren!"
Exit Sub
Else
'MsgBox "Vertragsvorlage ist aktuell!"
End If
Dim strdatei As String
Dim strArtAnmeldung As String
Dim strdatum As String
Dim strKundenname As String
Dim strplz As String
Dim strfirmaKurz As String
Dim strunternehmenkd As String
Dim strprojektbeginn As String
Dim streinsatzort As String
Dim strMitarbeiterAnrede As String
Dim strMitarbeiterAnrede2 As String
Dim strMitarbeiterGeburts As String
Dim strMitarbeiterStrasse As String
Dim strMitarbeiterPLZ As String
Dim strMitarbeiterOrt As String
Dim strMitarbeiterBeruf As String
Dim streinsatzgebiet As String
Dim strgehalt As String
Dim strurlaubstage As String
'Projektname zerlegen
Dim vy As Variant
vy = Split(Worksheets("Vorlage").Cells(1, 2), " - ") ' SPACE Bindestrich SPACE als Trennzeichen
Dim strP_Nr As String
Dim strP_Kd As String
Dim strP_Name As String
strP_Nr = vy(0)
strP_Kd = vy(1)
strP_Name = vy(2)
'Mitarbeitername in Vor- und Nachname zerlegen
Dim strMitarbeitername As String
strMitarbeitername = Worksheets("Vorlage").Cells(29, 2)
Dim vz As Variant
vz = Split(strMitarbeitername, ", ") ' KOMMA SPACE als Trennzeichen
Dim strMA_Vorname As String
Dim strMA_Nachname As String
strMA_Vorname = vz(1)
strMA_Vorname = RTrim$(strMA_Vorname)
strMA_Vorname = LTrim$(strMA_Vorname)
strMA_Nachname = vz(0)
strMA_Nachname = RTrim$(strMA_Nachname)
strMA_Nachname = LTrim$(strMA_Nachname)
Dim strEmailma As String
Dim strTelma As String
strEmailma = Worksheets("Vorlage").Cells(30, 2)
strTelma = Worksheets("Vorlage").Cells(31, 2)
'Anrede Mitarbeiter festlegen
Dim strMA_Anrede As String
Dim strMA_Anrede2 As String
strMA_Anrede = Worksheets("Vorlage").Cells(28, 2)
If strMA_Anrede = "Herr" Then
strMA_Anrede2 = "Herrn"
Else
strMA_Anrede2 = "Frau"
End If
'Anmeldung kürzen
strArtAnmeldung = Left(Worksheets("Vorlage").Cells(46, 2), 4)
strdatum = Worksheets("Vorlage").Cells(48, 2)
strgehalt = Worksheets("Vorlage").Cells(39, 4)
strMitarbeiterPLZ = Worksheets("Vorlage").Cells(34, 2)
strMitarbeiterGeburts = Worksheets("Vorlage").Cells(35, 4)
strMitarbeiterOrt = Worksheets("Vorlage").Cells(35, 2)
strMitarbeiterBeruf = Worksheets("Vorlage").Cells(45, 2)
strunternehmenkd = Worksheets("Vorlage").Cells(7, 2)
strfirmaKurz = Worksheets("Vorlage").Cells(8, 2)
strprojektbeginn = Worksheets("Vorlage").Cells(47, 2)
streinsatzort = Worksheets("Vorlage").Cells(24, 2)
strurlaubstage = Worksheets("Vorlage").Cells(41, 2)
Dim strProjektnameSpezial As String
strProjektnameSpezial = strP_Nr & " - " & strP_Name & " " & strfirmaKurz
'Word-Dokument öffnen
Dim appWord As Object
Set appWord = CreateObject("Word.Application")
appWord.Visible = True
Dim filename As String
Dim file As String
file = "gehalt_sachl_befristet_name_vorname_av_projektnummer.doc"
filename = "C:\Eigene Dateien\Automatisierung\Vorlagen\" & file
Dim nDoc As Word.Document 'Dokument 'Angebotsvorlage'
Set nDoc = appWord.Documents.Open(filename)
Dim strname As String
Dim strName2 As String
Dim path As String
'Textmarke "X" in Dokument nDoc mit "Variabel" ersetzen
fkt_ReplaceBookmarkText nDoc, "MitarbeiterAnrede", strMA_Anrede2 '
fkt_ReplaceBookmarkText nDoc, "MitarbeiterAnrede2", strMA_Anrede '
fkt_ReplaceBookmarkText nDoc, "MitarbeiterVorname", strMA_Vorname '
fkt_ReplaceBookmarkText nDoc, "MitarbeiterVorname2", strMA_Vorname '
fkt_ReplaceBookmarkText nDoc, "MitarbeiterVorname3", strMA_Vorname '
fkt_ReplaceBookmarkText nDoc, "MitarbeiterNachname", strMA_Nachname '
fkt_ReplaceBookmarkText nDoc, "MitarbeiterNachname2", strMA_Nachname '
fkt_ReplaceBookmarkText nDoc, "MitarbeiterNachname3", strMA_Nachname '
fkt_ReplaceBookmarkText nDoc, "MitarbeiterGeburtsdatum", strMitarbeiterGeburts '
fkt_ReplaceBookmarkText nDoc, "plz", strMitarbeiterPLZ '
fkt_ReplaceBookmarkText nDoc, "MitarbeiterOrt", strMitarbeiterOrt '
fkt_ReplaceBookmarkText nDoc, "MitarbeiterBeruf", strMitarbeiterBeruf '
fkt_ReplaceBookmarkText nDoc, "Einsatzort", streinsatzort '
fkt_ReplaceBookmarkText nDoc, "Projektbeginn", strprojektbeginn '
fkt_ReplaceBookmarkText nDoc, "Projekttitel", strProjektnameSpezial '
fkt_ReplaceBookmarkText nDoc, "Gehalt", strgehalt '
fkt_ReplaceBookmarkText nDoc, "Datum", strdatum '
fkt_ReplaceBookmarkText nDoc, "Datum2", strdatum '
fkt_ReplaceBookmarkText nDoc, "urlaubstage", strurlaubstage '
' Löscht alle Textmarken im Haupttext
Dim tm As Bookmark
For Each tm In nDoc.Bookmarks
tm.Delete
Next tm
'Ab hier hackt es
With Dialogs(wdDialogFileSaveAs)
.Name = "X:\Mitarbeiter\Verträge\Rhein_Main\Angestellte\AV_in bearbeitung\" & strMA_Nachname & "_" & strMA_Vorname & "_AV_" & strP_Nr & ".doc"
'.Format = wdFormatdoc
.Show
End With
End Sub