Serienbrief über VBA mit Userform

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Serienbrief über VBA mit Userform
von: AJ
Geschrieben am: 11.09.2015 19:26:07

VBA Autodruck
Hallo, ich bastel gerade an einem kleinen Projekt von mir und komme einfach nicht weiter. Es ist eine Art vereinfachter Serienbrief in Excel.
Folgendes Ziel habe ich.
Ich habe eine Userform Oberfläche mit einem Textfeld in dem ich eine Vertragsnummer eingeben kann und ein Button "Vollmacht eintragen" der das ganze startet. Folgendes sollte passieren wenn ich eine Vertragsnummer in das Textfeld eingebe und auf den Button drücke.
1. Die Vertragsnummer wird in die Tabelle "Daten" in Zeile "A1" geschrieben.
2. Über eine Art Sverweise VBA werden die restlichen Spalten die rechts neben der Vertragsnummer stehen ausgefüllt. "Anrede, Vorname, Name, Strasse, PLZ, Ort". Der Sverweis schaut dabei in der Tabelle "Datenpool" nach der Vertragsnummer und den restlichen Daten und füllt diese aus.
3. Die Briefvorlage habe ich als Excel in die Dieser Arbeitsmappe als Tabellenblatt "Vollmacht" eingefügt, so das ich jede Zeile und Spalte in dieser Briefvorlage ansprechen kann.
4. Über einen weiteren Button "Jetzt drucken" werden automatisch alle Briefe mit den Daten aus dem Tabellenblatt "Daten" befüllt und die Briefe werden auf einen definierten Drucker gedruckt.
Bedingungen:
Sollte in Punkt 1 beschrieben A1 bereits beschrieben sein, wird die Vertragsnummer in A2 geschrieben.
Ich habe mir mit viel Hilfe und dem www einige Codes zusammengebastelt.
Code für Schleife, schaut nach was in der letzten Zeile geschrieben wurde und erweitert es

Option Explicit


Function LastRowInOneColumn(Column As String) As Double
'Find the last used row in a Column: column A in this example
    Dim LastRow As Long
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, Column).End(xlUp).row
    End With
    LastRowInOneColumn = LastRow
End Function

Function LastColumnInOneRow(row As Double) As Double
'Find the last used column in a Row: row 1 in this example
Dim LastCol As Integer
With ActiveSheet
LastCol = .Cells(row, .Columns.Count).End(xlToLeft).Column
End With
LastColumnInOneRow = LastCol
End Function


Code um über die Vertragsnummer im Tabellenblatt "Daten" die restlichen Felder auszufüllen

Option Explicit

Sub test()
Dim z As Long, lz As Long, s As Integer
lz = Range("A65536").End(xlUp).row
If Range("A65536") <> "" Then lz = 65536
 
 
On Error Resume Next
For z = 2 To lz 'Zeilen
    For s = 2 To 20 'Spalten, kann erweitert werden
    Select Case (s)
    Case 7, 16, 18, 19, 20: 'Felder die in dem Datenpool rausgezogen werden sollen
        Cells(z, LastColumnInOneRow(CDbl(z)) + 1).Value = WorksheetFunction.VLookup(Cells(z, 1). _
 _
 _
 _
 _
 _
Value, Range("SSR"), s, False)
        If Err.Number > 0 Then
            Err.Clear
            Cells(z, s) = "#NV!"
        End If
'    Case 7: Cells(z, 4).Value = WorksheetFunction.VLookup(Cells(z, 1).Value, Range("SSR"), s,   _
 _
 _
 _
 _
_
False)
    Case Else
    
    End Select
            
    Next s
Next z
 
End Sub

Code um den Brief "Vollmachten" mit den Daten aus "Daten" auszufüllen

Sub brief()
 
    Dim iRow As Integer
    Dim i As Integer
    Dim strPath As String
    
    strPath = "\\PFAD"
    
    ThisWorkbook.Sheets("Vollmachten").Activate
    iRow = LastRowInOneColumn("A")
    ThisWorkbook.Sheets("Briefvorlage").Activate
    
    For i = 2 To iRow
    
        ThisWorkbook.Sheets("Daten").Range("B9") = ThisWorkbook.Sheets("Vollmachten").Range("B"  _
 _
 _
 _
 _
 _
& i) 'Anrede
        ThisWorkbook.Sheets("Daten").Range("B10") = ThisWorkbook.Sheets("Vollmachten").Range("e" _
 _
 _
 _
 _
 _
 & i) & " " & ThisWorkbook.Sheets("Vollmachten").Range("d" & i) 'Name
        ThisWorkbook.Sheets("Daten").Range("B11") = ThisWorkbook.Sheets("Vollmachten").Range("F" _
 _
 _
 _
 _
 _
 & i) 'Strasse
        ThisWorkbook.Sheets("Daten").Range("B12") = ThisWorkbook.Sheets("Vollmachten").Range("G" _
 _
 _
 _
 _
 _
 & i) & " " & ThisWorkbook.Sheets("Vollmachten").Range("H" & i) 'Ort
        ThisWorkbook.Sheets("Daten").Range("B28") = "wir nehmen Bezug auf Ihr Schreiben bzw.  _
auf unser Telefonat vom " & ThisWorkbook.Sheets("Vollmachten").Range("I" & i) & " und teilen  _
Ihnen mit, dass " 'Datum
    
    Save_pdf strPath, CStr(ThisWorkbook.Sheets("Vollmachten").Range("A" & i))
    
    Next
 
End Sub


Code für das drucken bzw. speichern auf PDF, hier als PDF Speicherung

Sub Save_pdf(Name As String)
 
    ChDir "\\PFAD"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "\\PFAD" & Name & ".pdf", Quality:= _
        xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
End Sub

Jetzt zu meiner frage, wie bringe ich alles nun zusammen? Als einzelne Codes funktionieren sie auch, ausser der Druckcode und ich weiss nicht wie ich die Userform mit Befehlen anreichre, so das alles gestartet wird.
Ich weiss das ist ziemlich viel, vielleicht bekomme ich ja so einfach ein paar Tipps oder Verbesserungsvorschläge? Oder wohlmöglich gibt es eine viel einfachere Lösung.
LG

Bild

Betrifft: AW: Serienbrief über VBA mit Userform
von: Werner
Geschrieben am: 11.09.2015 20:41:21
Hallo,
das bist du doch auch?!?
https://www.herber.de/forum/messages/1447079.html
Von Antwort auf die Hilfsangebote scheinst du ja nicht viel zu halten.
Gruß Werner

Bild

Betrifft: AW: Serienbrief über VBA mit Userform
von: AJ
Geschrieben am: 12.09.2015 07:00:51
Hallo Werner, du hast vollkommen recht, sehr wertschätzend war das nicht. Hatte erst jetzt gesehen das bereits antworten vorliegen. Vielen Dank dafür. Da mir das von mir hier beschriebene Problem etwas zu durcheinander ist, schliesse ich diese Punkte. Die Lösung mit dem Button klick hilft mir erstmal weiter, so das ich die Funktionen nochmal testen kann um zu schauen wo es hängt.
Vielen Dank erstmal
Lg

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Serienbrief über VBA mit Userform"