Private
Sub
Ausland_Click()
Dim
strFileName
As
String
Dim
strTMP1
As
String
Dim
strTMP2
As
String
Dim
strTMP3
As
String
Dim
strTMP4
As
String
Dim
strTMP5
As
String
Dim
strTMP6
As
String
Dim
strTMP7
As
String
Dim
strTMP8
As
String
Dim
strTMP9
As
String
Dim
strTMP10
As
String
Dim
strTMP11
As
String
Dim
strTMP12
As
String
Dim
strTMP13
As
String
Dim
strTMP14
As
String
Dim
strTMP15
As
String
Dim
objWDApp
As
Object
Dim
objDoc
As
Object
On
Error
GoTo
Fin
strFileName = ThisWorkbook.Path &
"\" & "
Dokument2.dot"
If
Dir(strFileName) <>
""
Then
Application.ScreenUpdating =
False
With
UserForm1
strTMP1 = tbName.Value
strTMP2 = tbVorname.Value
strTMP3 = tbTitel.Value
strTMP4 = tbStraße.Value
strTMP5 = tbNr.Value
strTMP6 = tbPLZ.Value
strTMP7 = tbOrt.Value
strTMP8 = tbKassenzeichen.Value
strTMP9 = tbBetrag.Value
strTMP10 = tbBezeichnung.Value
strTMP13 = tbZusatz.Value
strTMP14 = tbBezeichnung2.Value
strTMP15 = cbxLand.Value
End
With
If
Not
cbxAnrede.Value =
"Firma"
Then
strTMP11 = cbxAnrede.Value
End
If
Select
Case
cbxAnrede.Value
Case
"Frau und Herrn"
strTMP12 =
"Sehr geehrte Frau, sehr geehrter Herr"
&
" "
& tbName &
","
Case
"Frau"
strTMP12 =
"Sehr geehrte Frau"
&
" "
& tbName &
","
Case
"Herrn"
strTMP12 =
"Sehr geehrter Herr"
&
" "
& tbName &
","
Case
Else
strTMP12 =
"Sehr geehrte Damen und Herren,"
End
Select
On
Error
Resume
Next
Set
objWDApp = GetObject(,
"Word.Application"
)
If
objWDApp
Is
Nothing
Then
Set
objWDApp = CreateObject(
"Word.Application"
)
On
Error
GoTo
Fin
With
objWDApp
.Visible =
True
Set
objDoc = .Documents.Open(strFileName)
.ActiveDocument.Bookmarks(
"tmVorname"
).Range = strTMP1
.ActiveDocument.Bookmarks(
"tmName"
).Range = strTMP2
.ActiveDocument.Bookmarks(
"tmTitel"
).Range = strTMP3
.ActiveDocument.Bookmarks(
"tmStraße"
).Range = strTMP4
.ActiveDocument.Bookmarks(
"tmNr"
).Range = strTMP5
.ActiveDocument.Bookmarks(
"tmPLZ"
).Range = strTMP6
.ActiveDocument.Bookmarks(
"tmOrt"
).Range = strTMP7
.ActiveDocument.Bookmarks(
"tmKassenzeichen"
).Range = strTMP8
.ActiveDocument.Bookmarks(
"tmBetrag"
).Range = strTMP9
.ActiveDocument.Bookmarks(
"tmBezeichnung"
).Range = strTMP10
.ActiveDocument.Bookmarks(
"tmAnrede"
).Range = strTMP11
.ActiveDocument.Bookmarks(
"tmAnrede2"
).Range = strTMP12
.ActiveDocument.Bookmarks(
"tmZusatz"
).Range = strTMP13
.ActiveDocument.Bookmarks(
"tmBezeichnung2"
).Range = strTMP14
.ActiveDocument.Bookmarks(
"tmLand"
).Range = strTMP15
End
With
MsgBox
"Finished!"
Else
MsgBox
"No file!"
End
If
Fin:
Application.ScreenUpdating =
True
If
Not
objDoc
Is
Nothing
Then
objDoc.SaveAs
"xxxx\Desktop\" & tbKassenzeichen & "
_
" & tbBeleg & "
.doc"
objDoc.PrintOut Copies:=1
objDoc.Close
Set
objDoc =
Nothing
Set
objWDApp =
Nothing
End
Sub