VBA-Forum - Das Forum zu Microsoft VBA

VBA Excel VBA Word VBA Access VBA VBScript VB C# Objective-C C++ SQL JAVA VBA (English) Jobs Übersicht

Thema	Datum	Von Nutzer	Rating	Antwort
excel an textmarke word	25.08.2015 11:21:24	Gast

Ansicht des Beitrags:

Von:
Gast

Datum:
25.08.2015 11:21:24

Views:
1167

Rating:

Antwort:

Thema:
excel an textmarke word

Hallo,

ich habe ein Problem was ich nicht wirklich nachbollziehen kann. Hab aber ehrlich gesagt nicht wirklich Ahnung von ...

ich hab ne Excel Datei, mit einem Userform....bei Klick wird die Rechnung gedruckt. Hat alles wunderbar funktioniert.

Private Sub Rechnungsdruck_Click()
    ' Variablendeklaration
    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
    ' Bei einer Fehlermeldung springe zur angegebenen Sprungmarke
    On Error GoTo Fin
    ' Die Variable wird mit dem Pfad und dem Dateinamen gefüllt
    strFileName = ThisWorkbook.Path & "\" & "Dokument.dot"
    ' Mache nur weiter, wenn die Datei vorhanden ist
    If Dir(strFileName) <> "" Then
        ' Die Bildschirmaktualisierung wird ausgeschaltet
        Application.ScreenUpdating = False
        ' Beziehe dich auf das Tabellenblatt mit dem CodeNamen Sheet1
        ' Alles was sich auf den "With-Rahmen"
        ' bezieht muss mit einem Punkt beginnen
        ' With ist einfach eine bequemere Art Code zu schreiben
        ' Allerdings auch Fehleranfälliger, denn schon einen Punkt
        ' vergessen bringt u. U. Probleme mit sich
        With UserForm1
            ' Die Variablen werden mit dem Inhalt der Zellen befüllt
            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
        ' Ignoriere einen eventuell auftretenden Fehler und mache
        ' mit der nächsten Anweisung weiter
        ' Damit kann überprüft werden, ob Word offen ist
        On Error Resume Next
        ' Ist Word schon offen, dann belege die Objektvariable
        ' Objektvariable werden mit "Set" gefüllt
        Set objWDApp = GetObject(, "Word.Application")
        ' Wenn Word nicht offen ist, dann starte es
        If objWDApp Is Nothing Then Set objWDApp = CreateObject("Word.Application")
        ' Die Fehlerbehandlung wird wieder zurück gesetzt
        On Error GoTo Fin
        With objWDApp
            ' Hier wird gesteuert, ob Word sichtbar oder unsichtbar sein soll
            .Visible = True
            ' Die Worddatei wird geöffnet
            Set objDoc = .Documents.Open(strFileName)
            ' An dien entsprechenden Textmarken wird der Inhalt der
            ' Variablen eingefügt
            .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
          End With
        ' Hinweis, dass alles erledigt ist
        MsgBox "Finished!"
    Else
        ' Die Datei ist nicht vorhanden
        MsgBox "No file!"
    End If
Fin:
    ' Die Bildschirmaktualisierung wird wieder eingeschaltet
    Application.ScreenUpdating = True
    If Not objDoc Is Nothing Then objDoc.SaveAs "xxxxx\2015_Rechnungen\" & tbKassenzeichen & "_" & tbBeleg & ".doc"
    objDoc.PrintOut Copies:=1
    objDoc.Close
    ' Leeren der Objektvariablen
    Set objDoc = Nothing
    Set objWDApp = Nothing
End Sub

Jetzt habe ich einen zweiten Button hinzugefügt für Auslandszahlunge. Das obige Dokument kals dot kopiert die dazugehörige Textmarke tmLand definiert und seltsamerweise funktioniert dann die übergange der cbxAnrede-Kombobox und der cbxLand-Kombobox nicht mehr....hier der Code:

Private Sub Ausland_Click()
' Variablendeklaration
    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
    ' Bei einer Fehlermeldung springe zur angegebenen Sprungmarke
    On Error GoTo Fin
    ' Die Variable wird mit dem Pfad und dem Dateinamen gefüllt
    strFileName = ThisWorkbook.Path & "\" & "Dokument2.dot"
    ' Mache nur weiter, wenn die Datei vorhanden ist
    If Dir(strFileName) <> "" Then
        ' Die Bildschirmaktualisierung wird ausgeschaltet
        Application.ScreenUpdating = False
        ' Beziehe dich auf das Tabellenblatt mit dem CodeNamen Sheet1
        ' Alles was sich auf den "With-Rahmen"
        ' bezieht muss mit einem Punkt beginnen
        ' With ist einfach eine bequemere Art Code zu schreiben
        ' Allerdings auch Fehleranfälliger, denn schon einen Punkt
        ' vergessen bringt u. U. Probleme mit sich
        With UserForm1
            ' Die Variablen werden mit dem Inhalt der Zellen befüllt
            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
        ' Ignoriere einen eventuell auftretenden Fehler und mache
        ' mit der nächsten Anweisung weiter
        ' Damit kann überprüft werden, ob Word offen ist
        On Error Resume Next
        ' Ist Word schon offen, dann belege die Objektvariable
        ' Objektvariable werden mit "Set" gefüllt
        Set objWDApp = GetObject(, "Word.Application")
        ' Wenn Word nicht offen ist, dann starte es
        If objWDApp Is Nothing Then Set objWDApp = CreateObject("Word.Application")
        ' Die Fehlerbehandlung wird wieder zurück gesetzt
        On Error GoTo Fin
        With objWDApp
            ' Hier wird gesteuert, ob Word sichtbar oder unsichtbar sein soll
            .Visible = True
            ' Die Worddatei wird geöffnet
            Set objDoc = .Documents.Open(strFileName)
            ' An dien entsprechenden Textmarken wird der Inhalt der
            ' Variablen eingefügt
            .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
        ' Hinweis, dass alles erledigt ist
        MsgBox "Finished!"
    Else
        ' Die Datei ist nicht vorhanden
        MsgBox "No file!"
    End If
Fin:
    ' Die Bildschirmaktualisierung wird wieder eingeschaltet
    Application.ScreenUpdating = True
    If Not objDoc Is Nothing Then objDoc.SaveAs "xxxx\Desktop\" & tbKassenzeichen & "_" & tbBeleg & ".doc"
    objDoc.PrintOut Copies:=1
    objDoc.Close
    ' Leeren der Objektvariablen
    Set objDoc = Nothing
    Set objWDApp = Nothing

End Sub

Bitte helft mir, ich raff es nicht

Ihre Antwort

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema:		Name:		Email:

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema	Datum	Von Nutzer	Rating	Antwort
excel an textmarke word	25.08.2015 11:21:24	Gast