Serienbrief über VBA mit Userform
11.09.2015 19:26:07
AJ
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
Anzeige