Hilfe, mit Excel VBA Word Dokument drucken
03.07.2024 17:02:41
Tobias1404
Ein Word dokument wird geöffnet, ausgefüllt und soll gedruckt werden
Leider funktioniert das nicht immer. manchmal geht´s manchmal nicht.
Könnt Ihr mir bitte Helfen ?
Private Sub CommandButton1_Click()
ThisWorkbook.Activate
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("Daten").Range("J28").Value = "Aktenvermerk"
Application.Cursor = xlWait
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Word öffnen!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Dim appWord As Object
Dim strDoc As String
Dim Formular As Object
strDoc = ThisWorkbook.Worksheets("Daten").Range("C5")
Set appWord = CreateObject("Word.Application")
Set Formular = appWord.Documents.Add(strDoc)
'!!!!!!!!!!!!!!!!
appWord.Visible = False
Application.ScreenUpdating = False
Formular.Activate
If Formular.bookmarks.Exists("Text2_Nachname") Then
Formular.Formfields("Text2_Nachname").result = Range("Nachname").Value & ", " & Range("Vorname").Value
Else
MsgBox "es ist ein Fehler aufgetreten"
End If
If Formular.bookmarks.Exists("Text13_WG") Then
Formular.Formfields("Text13_WG").result = Range("WG").Value
Else
MsgBox "es ist ein Fehler aufgetreten"
End If
If Formular.bookmarks.Exists("Text1_Zimmer") Then
Formular.Formfields("Text1_Zimmer").result = Range("Zimmer").Value
Else
MsgBox "es ist ein Fehler aufgetreten"
End If
If Formular.bookmarks.Exists("Text11_Gebdat") Then
Formular.Formfields("Text11_Gebdat").result = Range("Geburtsdatum").Value
Else
MsgBox "es ist ein Fehler aufgetreten"
End If
If Formular.bookmarks.Exists("Text4_Buch") Then
Formular.Formfields("Text4_Buch").result = Range("Buchnummer").Value
Else
MsgBox "es ist ein Fehler aufgetreten"
End If
If Formular.bookmarks.Exists("Text16") Then
Formular.bookmarks("Text16").Range.Fields(1).result.Text = Antrag_Mobiltelefon.TextBox1.Value
Else
MsgBox "es ist ein Fehler aufgetreten"
End If
appWord.PrintOut
On Error GoTo fehlermeldung
Formular.Saved = True 'für "ohne speichern" schließen
appWord.Documents.Close savechanges:=False
appWord.Quit 0
Set Formular = Nothing
Set appWord = Nothing
Dim objControl As Control
For Each objControl In Controls
Select Case TypeName(objControl)
Case "TextBox"
objControl.Text = ""
Case "ComboBox"
objControl.ListIndex = -1
Case "CheckBox"
objControl.Value = False
Case "OptionButton"
objControl.Value = False
End Select
Next
ThisWorkbook.Worksheets("Daten").Range("A28:N28").Value = ""
ThisWorkbook.Worksheets("Daten").Range("A31:N31").Value = ""
Application.Visible = False
Application.Cursor = xlDefault
Unload Me
Application.ScreenUpdating = True
Vielen Dank
Anzeige