| Word.Application, Word.Document |
|
|
| Sub cmdWord_Click() |
| Dim WordObj As New Word.Application |
| Dim WordDoc As New Word.Document |
| Dim dName$ |
| dName = "C:\Windows\Testdokument.doc" |
| On Error GoTo w |
| AppActivate "Microsoft Word" |
| Set WordObj = Word.Application |
| GoTo n |
| w: |
| Set WordObj = CreateObject("Word.Application") |
| n: |
| Set WordDoc = WordObj.Documents.Add(dName) |
| WordObj.Visible = True |
| WordObj.Application.Selection.TypeParagraph |
| WordObj.Application.Selection.TypeText Text:=TextBox1.Text |
| WordObj.Application.Selection.TypeParagraph |
| If TextBox2.Text = "" Then |
| WordObj.Application.Selection.TypeText Text:=TextBox3.Text |
| Else |
| If TextBox1.Text <> "Firma" Then |
| WordObj.Application.Selection.TypeText Text:=TextBox2.Text & " " & TextBox3.Text |
| Else |
| WordObj.Application.Selection.TypeText Text:=TextBox2.Text |
| WordObj.Application.Selection.TypeParagraph |
| WordObj.Application.Selection.TypeText Text:=TextBox3.Text |
| End If |
| End If |
| WordObj.Application.Selection.TypeParagraph |
| WordObj.Application.Selection.TypeText Text:=TextBox4.Text & " " & TextBox5.Text |
| WordObj.Application.Selection.TypeParagraph |
| If Textbox6.Text = "D" Or Textbox6.Text = "DE" Then |
| WordObj.Application.Selection.TypeText Text:=TextBox7.Text & " " & TextBox8.Text |
| Else |
| WordObj.Application.Selection.TypeText Text:=Textbox6.Text & " - " & _ |
| TextBox7.Text & " " & TextBox8.Text |
| End If |
| WordObj.Application.Selection.TypeParagraph |
| WordObj.Application.Selection.TypeParagraph |
| WordObj.Application.Selection.TypeParagraph |
| WordObj.Application.Selection.TypeParagraph |
| If TextBox1.Text = "Herr" Then |
| WordObj.Application.Selection.TypeText Text:="Sehr geehrter Herr " & TextBox3.Text & ", " |
| WordObj.Application.Selection.TypeParagraph |
| WordObj.Application.Selection.TypeParagraph |
| ElseIf TextBox1.Text = "Frau" Then |
| WordObj.Application.Selection.TypeText Text:="Sehr geehrte Frau " & TextBox3.Text & ", " |
| WordObj.Application.Selection.TypeParagraph |
| WordObj.Application.Selection.TypeParagraph |
| Else |
| WordObj.Application.Selection.TypeText Text:="Sehr geehrte " |
| End If |
| End Sub |
|
| |
|
| ... und noch eine Lösung... |
|
| Const DateiInland$ = "C:\Letter_Inland.dot" |
| Const DateiAusland$ = "C:\Letter_Ausland.dot" |
| Const BriefOrt$ = "München, den " |
| Dim W As Worksheet, TBereich$ |
| 'Die Word.Application muss zunächst oben im Menü referenziert werden |
| Dim WordObj As New Word.Application |
| Dim WordDoc As New Word.Document |
| 'Variablen für Spalten |
| Dim Anrede$, Nachna$, Vornam$ |
| Dim Strass$, HausNu$, Landtt$, PeElZe$, Ortttt$ |
| 'Schulungen |
| Dim BEword$, BEexcl$, BEaces$, BEpppt$, BEedit$ |
| Dim i& |
|
| Sub Button1_Click() |
| Start_Serienbrief |
| End Sub |
|
| Function Start_Serienbrief() |
| i = 0 |
| 'Prüft ob die Word-Vorlage vorhanden ist |
| If VBA.Dir(DateiInland) = "" Or VBA.Dir(DateiAusland) = "" Then |
| VBA.MsgBox "Die Briefvorlage ist nicht vorhanden!" & VBA.Chr(10) & _ |
| VBA.Chr(10) & "Bitte eine Vorlage erstellen und ins Verzeichnis WINNT stellen!" _ |
| & VBA.Chr(10), VBA.vbInformation, "Info" |
| Exit Function |
| End If |
| Set W = ThisWorkbook.Worksheets("Schulung") |
| On Error GoTo CreateWordObject |
| VBA.AppActivate "Microsoft Word" |
| Set WordObj = Word.Application |
| GoTo next_step |
| CreateWordObject: |
| Set WordObj = CreateObject("Word.Application") |
| next_step: |
| TBereich = W.Range("A1").CurrentRegion.Rows.Count |
| For i = 2 To TBereich |
| If W.Range("F" & (i)).Text = "D" Then |
| Set WordDoc = WordObj.Documents.Add(DateiInland) |
| Else |
| Set WordDoc = WordObj.Documents.Add(DateiAusland) |
| End If |
| 'Zeile auslesen |
| Anrede = W.Range("A" & (i)).Text |
| Nachna = W.Range("B" & (i)).Text |
| Vornam = W.Range("C" & (i)).Text |
| Strass = W.Range("D" & (i)).Text |
| HausNu = W.Range("E" & (i)).Text |
| Landtt = W.Range("F" & (i)).Text |
| PeElZe = W.Range("G" & (i)).Text |
| Ortttt = W.Range("H" & (i)).Text |
| 'Lehrgänge lesen |
| BEword = W.Range("I" & (i)).Text |
| BEexcl = W.Range("J" & (i)).Text |
| BEaces = W.Range("K" & (i)).Text |
| BEpppt = W.Range("L" & (i)).Text |
| BEedit = W.Range("M" & (i)).Text |
| 'Word Fehlermeldung abschalten |
| WordObj.Application.DisplayAlerts = Word.wdAlertsNone |
| 'Seriendruck für jede Zeile starten |
| Call WordSerie(WordObj, Anrede, Vornam, Nachna, Strass, HausNu, _ |
| Landtt, PeElZe, Ortttt, BEword, BEexcl, BEaces, BEpppt, BEedit) |
| WordDoc.Application.DisplayAlerts = Word.wdAlertsNone |
| 'Speichern des Word-Dokuments unterbinden |
| WordObj.Options.SavePropertiesPrompt = False |
| 'braucht bei mir kleine Pause, sonst Fehler |
| Application.Wait VBA.Now + VBA.TimeSerial(0, 0, 5) |
| 'Speichern wird nur simuliert |
| WordDoc.Saved = True |
| Set WordDoc = Nothing |
| 'Abfrage beim ersten Ausdruck, ob OK |
| If i <= 2 Then |
| If VBA.MsgBox("Es wird ein Testausdruck erzeugt. Ist der Testausdruck OK und " & _ |
| VBA.vbCrLf & "soll das Drucken fortgesetzt werden? ", VBA.vbQuestion + _ |
| VBA.vbOKCancel + VBA.vbDefaultButton2, "Testausdruck läuft...") = VBA.vbOK Then |
| 'mach weiter |
| Else |
| WordObj.Quit |
| Set WordObj = Nothing |
| Exit Function |
| End If |
| End If |
| Next i |
| WordObj.Quit |
| Set WordObj = Nothing |
| End Function |
|
| Function WordSerie(WordObj, Anr, Vorn, Nachn, Stras, HaNr, Lant, _ |
| PLZt, Orrt, Bword, Bexcl, Baces, Bpppt, Bedit) |
| On Error Resume Next |
| With WordObj.Application.Selection |
| .TypeParagraph |
| If Anr <> "" Then |
| .TypeText Text:=Anr |
| .TypeParagraph |
| End If |
| If Vorn = "" Then |
| .TypeText Text:=Nachn |
| Else |
| If Anr <> "Firma" And Anr <> "" Then |
| .TypeText Text:=Vorn & " " & Nachn |
| Else |
| .TypeText Text:=Nachn |
| .TypeParagraph |
| .TypeText Text:=Vorn |
| End If |
| End If |
| .TypeParagraph |
| .TypeText Text:=Stras & " " & HaNr |
| .TypeParagraph |
| If Lant = "D" Or Lant = "DE" Then |
| .TypeText Text:=PLZt & " " & Orrt |
| Else |
| .TypeText Text:=Lant & " - " & PLZt & " " & Orrt |
| End If |
| .TypeParagraph |
| .ParagraphFormat.Alignment = Word.wdAlignParagraphRight |
| .TypeText Text:=BriefOrt & VBA.Day(VBA.Date) & "." & VBA.Month(VBA.Date) & "." & VBA.Year(VBA.Date) |
| .TypeParagraph |
| .ParagraphFormat.Alignment = Word.wdAlignParagraphLeft |
| .TypeParagraph: .TypeParagraph |
| .TypeParagraph: .TypeParagraph |
| |
| 'Bereich "besuchte Kurse" |
| .Font.Underline = wdUnderlineSingle |
| .TypeText Text:="Besuchte Kurse:" |
| .TypeParagraph |
| .Font.Underline = wdUnderlineNone |
| |
| If Bword <> "" And Bword <> "B" Then |
| .TypeText "- " & Bword & ": Microsoft Word" |
| .TypeParagraph |
| Bword = "" |
| End If |
| If Bexcl <> "" And Bexcl <> "B" Then |
| .TypeText "- " & Bexcl & ": Microsoft Excel" |
| .TypeParagraph |
| Bexcl = "" |
| End If |
| If Baces <> "" And Baces <> "B" Then |
| .TypeText "- " & Baces & ": Microsoft Access" |
| .TypeParagraph |
| Baces = "" |
| End If |
| If Bpppt <> "" And Bpppt <> "B" Then |
| .TypeText "- " & Bpppt & ": Microsoft Powerpoint" |
| .TypeParagraph |
| Bpppt = "" |
| End If |
| If Bedit <> "" And Bedit <> "B" Then |
| .TypeText "- " & Bedit & ": Microsoft Multi Editor XP" |
| .TypeParagraph |
| Bedit = "" |
| End If |
| |
| .TypeParagraph: .TypeParagraph |
| |
| 'Bereich "offene Kurse" |
| .Font.Underline = wdUnderlineSingle |
| .TypeText Text:="Möchte noch besuchen:" |
| .TypeParagraph |
| .Font.Underline = wdUnderlineNone |
| |
| If Bword = "B" Then |
| .TypeText "- Microsoft Word" |
| .TypeParagraph |
| Bword = "" |
| End If |
| If Bexcl = "B" Then |
| .TypeText "- Microsoft Excel" |
| .TypeParagraph |
| Bexcl = "" |
| End If |
| If Baces = "B" Then |
| .TypeText "- Microsoft Access" |
| .TypeParagraph |
| Baces = "" |
| End If |
| If Bpppt = "B" Then |
| .TypeText "- Microsoft Powerpoint" |
| .TypeParagraph |
| Bpppt = "" |
| End If |
| If Bedit = "B" Then |
| .TypeText "- Multi Editor XP" |
| .TypeParagraph |
| Bedit = "" |
| End If |
| |
| 'dann drucke mal |
| .Document.PrintOut |
| End With |
| End Function |
|
| |
|
| ... und noch eine Lösung mit Button in der Symbolleiste... |
 |
|
|
|
|
|
|
|
|
|
|
|
|
|
| Beim Öffnen des Workbooks wird Button in Symbolleiste erzeugt |
| Sub Workbook_Open() |
| Dim myControl As CommandBarButton |
| On Error Resume Next |
| Application.WindowState = xlMaximized |
| Application.CommandBars("Standard").Controls("Starte Word Serienbrief").Delete |
| Set myControl = Application.CommandBars("Standard").Controls. _ |
| Add(Type:=msoControlButton, Before:=5) |
| With myControl |
| .Style = msoButtonWrapCaption |
| .Width = 100 |
| .State = msoButtonDown |
| .Caption = "Starte Word Serienbrief" |
| .OnAction = "Brief_Start" |
| .Visible = True |
| End With |
| End Sub |
|
| Formular zum Markieren der Datensätze |
| Sub AlleMarkieren_Click() |
| On Error Resume Next |
| Dim c& |
| 'alle Einträge in der Listbox markieren |
| For c = 0 To frmSuchen.cbAuswahl.ListCount - 1 |
| frmSuchen.cbAuswahl.Selected(c) = True |
| Next |
| End Sub |
|
| Sub cmdExit_Click() |
| On Error Resume Next |
| Application.DisplayAlerts = False |
| Worksheets(TEMP1).Delete |
| Application.DisplayAlerts = True |
| Unload Me |
| End Sub |
|
| Sub cmdStart_Click() |
| Call Start_Serienbrief |
| End Sub |
|
| Sub UserForm_Terminate() |
| On Error Resume Next |
| frmSuchen.cmdExit_Click |
| WordDoc.Application.DisplayAlerts = Word.wdAlertsNone |
| WordObj.Options.SavePropertiesPrompt = False |
| WordObj.Quit |
| Set WordDoc = Nothing |
| Set WordObj = Nothing |
| Set W2 = Nothing |
| End Sub |
|
| Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) |
| If CloseMode <> 1 Then Cancel = 1 |
| End Sub |
|
| Modul |
| 'Wo ist die Winword.exe installiert? Sonst geht nix... |
| Public Const WinwordPfad$ = "C:\Programme\Office\Office10\" |
|
| 'Ort und Name der Word-Dokumentenvorlage |
| Public Const Dateivorlage$ = "U:\daten\Letter.dot" |
|
| 'Hier wird das fertige Word-Dokument abgespeichert |
| Public Const Laufwerk$ = "U:\daten\" |
|
| 'Worksheet Namen nie verändern! |
| Public Const WNAME$ = "Mitarbeiterliste wg durchgeführ" |
| Public Const TEMP1$ = "Temp" |
|
| Die Word.Application muss oben im Menü (Werkzeuge - Verweise) referenziert werden. |
| Beim Wechsel der Office-Release neue "Microsoft Word XXX Object-Library" zuweisen! |
| Public WordObj As New Word.Application |
| Public WordDoc As New Word.Document |
| Public W As Worksheet |
| Public W2 As Worksheet |
|
| 'Schulungen Überschriften |
| Public Const Kurs_I$ = "- Verkaufstraining Basis (Baumaschine & Stapler)" |
| Public Const Kurs_J$ = "- Verkaufstraining Fortgeschrittene" |
| Public Const Kurs_K$ = "- Verkaufstraining Refresher" |
| Public Const Kurs_L$ = "- Verkaufen am Telefon" |
| Public Const Kurs_M$ = "- Inkasso-Management" |
| Public Const Kurs_N$ = "- Mitarbeiterförderungsprogramm" |
| Public Const Kurs_O$ = "- Erfolgreiche Kundenberatung" |
| Public Const Kurs_P$ = "- B & F Seminare" |
| Public Const Kurs_Q$ = "- Kommunikationstraining für Disponenten" |
| Public Const Kurs_R$ = "- Ausbilderworkshop (Gewerbliche Ausbildung)" |
| Public Const Kurs_S$ = "- Workshop für kaufmännische Ausbildungsbeauftragte" |
| Public Const Kurs_T$ = "- 1 x 1 der Führungspraxis" |
| Public Const Kurs_U$ = "- Konflikte lösen bzw. Umgang mit schwierigen Führungssituationen" _ |
| & VBA.vbCrLf & " (Folgeseminar zum '1x1 der Führungspraxis')" |
| Public Const Kurs_V$ = "- Konflikte lösen bzw. Umgang mit schwierigen Führungssituationen" _ |
| & VBA.vbCrLf & " (ohne vorherige Teilnahme am '1x1 der Führungspraxis')" |
| Public Const Kurs_W$ = "- Meister / Disponenten führen Servicetechniker" |
| Public Const Kurs_X$ = "- Projektmanagement" |
| Public Const Kurs_Y$ = "- Rhetorik & Präsentation" |
| Public Const Kurs_Z$ = "- Verhalten und Verhandeln am Telefon" |
| Public Const Kurs_AA$ = "- Zielvereinbarung, Beurteilung, Förderung" |
| Public Const Kurs_AB$ = "- Verhalten und Verkaufen am Telefon" |
| Public Const Kurs_AC$ = "- MZSG" |
| Public Const Kurs_AD$ = "- Betriebsverfassungsrecht für Führungskräfte" |
| Public Const Kurs_AE$ = "- Basisschulung Baumaschinen" |
| Public Const Kurs_AF$ = "- Basisschulung Stapler" |
| Public Const Kurs_AG$ = "- Basisschulung ET/Komponenten" |
| Public Const Kurs_AH$ = "- Basisschulung Windows XP" |
| Public Const Kurs_AI$ = "- Basisschulung Kommunikation am Telefon" |
| Public Const Kurs_AJ$ = "- Basisschulung Telemarketing & Telefonverkauf" |
| Public Const Kurs_AK$ = "- Grundlagen der Erdbewegung I" |
| Public Const Kurs_AL$ = "- Grundlagen der Erdbewegung II" |
| Public Const Kurs_AM$ = "- Nachwuchsförderprogramm - NFP" |
| Public Const Kurs_AN$ = "- Development Center - ZDC" |
|
| 'Schulungen: Variablen für "Datum auslesen" |
| Public Datum_I$, Datum_J$, Datum_K$, Datum_L$, Datum_M$, Datum_N$ |
| Public Datum_O$, Datum_P$, Datum_Q$, Datum_R$, Datum_S$, Datum_T$ |
| Public Datum_U$, Datum_V$, Datum_W$, Datum_X$, Datum_Y$, Datum_Z$ |
| Public Datum_AA$, Datum_AB$, Datum_AC$, Datum_AD$, Datum_AE$, Datum_AF$ |
| Public Datum_AG$, Datum_AH$, Datum_AI$, Datum_AJ$, Datum_AK$, Datum_AL$ |
| Public Datum_AM$, Datum_AN$ |
|
| Public Nachna$, Vornam$ 'Namen Kursteilnehmer |
| Public Pfad$, DatName$ 'Pfad & Dateiname für das Word-Dokument |
| Public TBereich& 'Zeilen im Worksheet |
| Public i&, z& 'Listbox-Zähler |
|
| Sub Brief_Start() |
| Dim c% |
|
| 'Eventuelle "alte Word-Session" schließen |
| On Error Resume Next |
| WordObj.Options.SavePropertiesPrompt = False |
| WordObj.Quit |
| Set WordDoc = Nothing |
| Set WordObj = Nothing |
| Set W2 = Nothing |
| Set W = Nothing |
|
| 'ist der Pfad für Winword.exe korrekt? |
| If VBA.Dir(WinwordPfad) = "" Then |
| VBA.MsgBox "Der Dateipfad für Ausführung von Winword ist nicht korrekt! " & VBA.Chr(10) & _ |
| VBA.Chr(10) & "Bitte wenden Sie sich an Ihren Administrator!" _ |
| & VBA.Chr(10), VBA.vbInformation, "Info" |
| Exit Sub |
| End If |
|
| 'ist die Word-Vorlage vorhanden? |
| If VBA.Dir(Dateivorlage) = "" Then |
| VBA.MsgBox "Die Briefvorlage ist nicht vorhanden!" & VBA.Chr(10) & _ |
| VBA.Chr(10) & "Bitte eine Vorlage erstellen und ins Verzeichnis " & _ |
| Laufwerk & " stellen! " & VBA.Chr(10), VBA.vbInformation, "Info" |
| Exit Sub |
| End If |
|
| 'Worksheet direkt mit Namen ansprechen |
| Set W = ThisWorkbook.Worksheets(WNAME) |
| Application.DisplayAlerts = False |
|
| 'Gibt es das temporäre Worksheet schon? |
| For c = 1 To Worksheets.Count |
| If Worksheets(c).Name <> WNAME Then Worksheets(c).Delete |
| Next c |
|
| 'Temporäres Worksheet anlegen |
| Worksheets.Add.Move After:=Worksheets(Worksheets.Count) |
| ActiveSheet.Name = TEMP1 |
| Set W2 = ThisWorkbook.Worksheets(TEMP1) |
|
| 'Auswahl vom 1. Worksheet ins temp.Worksheet kopieren |
| W2.Cells.ClearContents |
| W.UsedRange.Copy W2.[A1] |
| TBereich = W2.Range("A1").CurrentRegion.Rows.Count |
|
| 'Listbox laden |
| If TBereich > 1 Then |
| frmSuchen.cbAuswahl.ColumnCount = 5 |
| frmSuchen.cbAuswahl.ColumnWidths = 65 & ";" & 55 & ";" & 80 & ";" & 35 & ";" & 55 |
| frmSuchen.cbAuswahl.RowSource = "D2:H" & TBereich |
| frmSuchen.cbAuswahl.MultiSelect = fmMultiSelectExtended |
|
| 'in den Worksheets die Spaltenbreite anpassen - sonst falsche Ausgabe in WORD! |
| W.Columns.AutoFit |
| W2.Columns.AutoFit |
| |
| Set W = Nothing |
| Set W2 = Nothing |
| |
| Application.DisplayAlerts = True |
| |
| frmSuchen.lblHinweis.Caption = "Im linken Fenster die gewünschten Datensätze anwählen" _ |
| & VBA.vbCrLf & VBA.vbCrLf & "(oder alles markieren)" & VBA.vbCrLf & VBA.vbCrLf & "Dann Seriendruck starten..." |
|
| 'in Listbox alle Einträge markieren |
| frmSuchen.AlleMarkieren_Click |
| frmSuchen.Show |
|
| Else |
|
| 'keine Teilnehmer ausgewählt = Abbruch |
| Set W = Nothing |
| Set W2 = Nothing |
| VBA.MsgBox "Keine Teilnehmer ausgewählt! " & VBA.Chr(10) & _ |
| VBA.Chr(10) & "Bitte wiederholen..." & VBA.Chr(10) _ |
| & VBA.Chr(10), VBA.vbInformation, "Info" |
| Application.DisplayAlerts = False |
| Worksheets(TEMP1).Delete |
| Application.DisplayAlerts = True |
| End If |
|
| End Sub |
|
|
| Function Start_Serienbrief() |
| i = 0: z = 0 |
|
| 'sind Einträge in der Listbox markiert? |
| For i = 0 To frmSuchen.cbAuswahl.ListCount - 1 |
| If frmSuchen.cbAuswahl.Selected(i) = True Then |
| z = z + 1 |
| End If |
| Next |
| If z = 0 Then |
| VBA.MsgBox "Keine Teilnehmer ausgewählt! " & VBA.Chr(10) & _ |
| VBA.Chr(10) & "Bitte wiederholen..." & VBA.Chr(10) _ |
| & VBA.Chr(10), VBA.vbInformation, "Info" |
| Exit Function |
| End If |
| |
| i = 0: z = 0 |
| Set W2 = ThisWorkbook.Worksheets(TEMP1) |
|
| 'Word.Application aufrufen |
| On Error GoTo CreateWordObject |
| VBA.AppActivate "Microsoft Word" |
| Set WordObj = Word.Application |
| GoTo next_step |
|
| CreateWordObject: |
| Set WordObj = CreateObject("Word.Application") |
|
| next_step: |
| On Error GoTo abbruch |
| TBereich = W2.Range("A1").CurrentRegion.Rows.Count |
| Set WordDoc = WordObj.Documents.Add(Dateivorlage) |
| For i = 0 To frmSuchen.cbAuswahl.ListCount - 1 |
| If frmSuchen.cbAuswahl.Selected(i) = True Then |
| z = z + 1 |
| If z > 1 Then |
| 'Seitenumbruch |
| WordObj.Application.Selection.InsertBreak Type:=wdPageBreak |
| End If |
| 'Namen in Zeile auslesen |
| Nachna = W2.Range("D" & (i + 2)).Text |
| Vornam = W2.Range("E" & (i + 2)).Text |
| 'Datum der Lehrgänge lesen |
| Datum_I = W2.Range("I" & (i + 2)).Text |
| Datum_J = W2.Range("J" & (i + 2)).Text |
| Datum_K = W2.Range("K" & (i + 2)).Text |
| Datum_L = W2.Range("L" & (i + 2)).Text |
| Datum_M = W2.Range("M" & (i + 2)).Text |
| Datum_N = W2.Range("N" & (i + 2)).Text |
| Datum_O = W2.Range("O" & (i + 2)).Text |
| Datum_P = W2.Range("P" & (i + 2)).Text |
| Datum_Q = W2.Range("Q" & (i + 2)).Text |
| Datum_R = W2.Range("R" & (i + 2)).Text |
| Datum_S = W2.Range("S" & (i + 2)).Text |
| Datum_T = W2.Range("T" & (i + 2)).Text |
| Datum_U = W2.Range("U" & (i + 2)).Text |
| Datum_V = W2.Range("V" & (i + 2)).Text |
| Datum_W = W2.Range("W" & (i + 2)).Text |
| Datum_X = W2.Range("X" & (i + 2)).Text |
| Datum_Y = W2.Range("Y" & (i + 2)).Text |
| Datum_Z = W2.Range("Z" & (i + 2)).Text |
| Datum_AA = W2.Range("AA" & (i + 2)).Text |
| Datum_AB = W2.Range("AB" & (i + 2)).Text |
| Datum_AC = W2.Range("AC" & (i + 2)).Text |
| Datum_AD = W2.Range("AD" & (i + 2)).Text |
| Datum_AE = W2.Range("AE" & (i + 2)).Text |
| Datum_AF = W2.Range("AF" & (i + 2)).Text |
| Datum_AG = W2.Range("AG" & (i + 2)).Text |
| Datum_AH = W2.Range("AH" & (i + 2)).Text |
| Datum_AI = W2.Range("AI" & (i + 2)).Text |
| Datum_AJ = W2.Range("AJ" & (i + 2)).Text |
| Datum_AK = W2.Range("AK" & (i + 2)).Text |
| Datum_AL = W2.Range("AL" & (i + 2)).Text |
| Datum_AM = W2.Range("AM" & (i + 2)).Text |
| Datum_AN = W2.Range("AN" & (i + 2)).Text |
| |
| 'Word Fehlermeldung abschalten |
| WordObj.Application.DisplayAlerts = Word.wdAlertsNone |
|
| 'Seriendruck für jede Zeile starten |
| Call WordSerie(WordObj, Vornam, Nachna, _ |
| Datum_I, Datum_J, Datum_K, Datum_L, Datum_M, Datum_N, _ |
| Datum_O, Datum_P, Datum_Q, Datum_R, Datum_S, Datum_T, _ |
| Datum_U, Datum_V, Datum_W, Datum_X, Datum_Y, Datum_Z, _ |
| Datum_AA, Datum_AB, Datum_AC, Datum_AD, Datum_AE, Datum_AF, _ |
| Datum_AG, Datum_AH, Datum_AI, Datum_AJ, Datum_AK, Datum_AL, _ |
| Datum_AM, Datum_AN) |
|
| VBA.DoEvents |
| frmSuchen.lblHinweis.Caption = z & " Datensätze verarbeitet" |
| frmSuchen.AlleMarkieren.Enabled = False |
| frmSuchen.cbAuswahl.Enabled = False |
| frmSuchen.cmdStart.Enabled = False |
| frmSuchen.cmdExit.Enabled = False |
|
| WordDoc.Application.DisplayAlerts = Word.wdAlertsNone |
|
| Nachna = "": Vornam = "" |
| Datum_I = "": Datum_J = "": Datum_K = "": Datum_L = "": Datum_M = "": Datum_N = "" |
| Datum_O = "": Datum_P = "": Datum_Q = "": Datum_R = "": Datum_S = "": Datum_T = "" |
| Datum_U = "": Datum_V = "": Datum_W = "": Datum_X = "": Datum_Y = "": Datum_Z = "" |
| Datum_AA = "": Datum_AB = "": Datum_AC = "": Datum_AD = "": Datum_AE = "": Datum_AF = "" |
| Datum_AG = "": Datum_AH = "": Datum_AI = "": Datum_AJ = "": Datum_AK = "": Datum_AL = "" |
| Datum_AM = "": Datum_AN = "" |
|
| End If |
| Next i |
|
| 'Speichern |
| If z >= 1 Then |
| DatName = Format(Now(), "yyyymmddhhmmss") & "_Trainings.doc" |
| Pfad = Laufwerk & DatName |
| WordObj.Options.SavePropertiesPrompt = False |
| WordDoc.SaveAs Pfad |
|
| If z = 1 Then |
| VBA.MsgBox z & " Datensatz wurde in Datei " & Pfad & " erzeugt.", VBA.vbInformation, "Info" |
| Else |
| VBA.MsgBox z & " Datensätze wurden in Datei " & Pfad & " erzeugt.", VBA.vbInformation, "Info" |
| End If |
|
| 'Word öffnen |
| ChDrive Left(ThisWorkbook.Path, 1) |
| ChDir ThisWorkbook.Path |
| Shell WinwordPfad & "winword.exe " & Pfad, 3 |
|
| Set WordDoc = Nothing |
| Set WordObj = Nothing |
| Set W2 = Nothing |
| Application.DisplayAlerts = False |
| Worksheets(TEMP1).Delete |
| Application.DisplayAlerts = True |
| Unload frmSuchen |
|
| End If |
| Exit Function |
|
| abbruch: |
| On Error Resume Next |
| WordObj.Options.SavePropertiesPrompt = False |
| WordObj.Quit |
| Set WordDoc = Nothing |
| Set WordObj = Nothing |
| Set W2 = Nothing |
| Application.DisplayAlerts = False |
| Worksheets(TEMP1).Delete |
| Application.DisplayAlerts = True |
| Unload frmSuchen |
| End Function |
|
|
| Function WordSerie(WordObj, Vorn, Nachn, _ |
| Text_I$, Text_J$, Text_K$, Text_L$, Text_M$, Text_N$, _ |
| Text_O$, Text_P$, Text_Q$, Text_R$, Text_S$, Text_T, _ |
| Text_U$, Text_V$, Text_W$, Text_X$, Text_Y$, Text_Z$, _ |
| Text_AA$, Text_AB$, Text_AC$, Text_AD$, Text_AE$, Text_AF$, _ |
| Text_AG$, Text_AH$, Text_AI$, Text_AJ$, Text_AK$, Text_AL$, _ |
| Text_AM$, Text_AN$) |
|
| Dim Training$ |
| On Error Resume Next 'Fehler durch Word-Applikation |
|
| Training = "" |
|
| With WordObj.Application.Selection |
| .Font.Bold = True |
| .Font.Size = 12 |
| |
| 'Nachname / Vorname schreiben |
| If Vorn = "" Then |
| .TypeText Text:=Nachn |
| Else |
| .TypeText Text:=Nachn & ", " & Vorn |
| End If |
| |
| .TypeParagraph: .TypeParagraph |
|
| '******************************************************** |
|
| 'Bereich "Besuchte Kurse" |
| .Font.Size = 10 |
| |
| If (Text_I <> "" And Text_I <> "B") Or (Text_J <> "" And Text_J <> "B") Or _ |
| (Text_K <> "" And Text_K <> "B") Or (Text_L <> "" And Text_L <> "B") Or _ |
| (Text_M <> "" And Text_M <> "B") Or (Text_N <> "" And Text_N <> "B") Or _ |
| (Text_O <> "" And Text_O <> "B") Or (Text_P <> "" And Text_P <> "B") Or _ |
| (Text_Q <> "" And Text_Q <> "B") Or (Text_R <> "" And Text_R <> "B") Or _ |
| (Text_S <> "" And Text_S <> "B") Or (Text_T <> "" And Text_T <> "B") Or _ |
| (Text_U <> "" And Text_U <> "B") Or (Text_V <> "" And Text_V <> "B") Or _ |
| (Text_W <> "" And Text_W <> "B") Or (Text_X <> "" And Text_X <> "B") Or _ |
| (Text_Y <> "" And Text_Y <> "B") Or (Text_Z <> "" And Text_Z <> "B") Or _ |
| (Text_AA <> "" And Text_AA <> "B") Or (Text_AB <> "" And Text_AB <> "B") Or _ |
| (Text_AC <> "" And Text_AC <> "B") Or (Text_AD <> "" And Text_AD <> "B") Or _ |
| (Text_AE <> "" And Text_AE <> "B") Or (Text_AF <> "" And Text_AF <> "B") Or _ |
| (Text_AG <> "" And Text_AG <> "B") Or (Text_AH <> "" And Text_AH <> "B") Or _ |
| (Text_AI <> "" And Text_AI <> "B") Or (Text_AJ <> "" And Text_AJ <> "B") Or _ |
| (Text_AK <> "" And Text_AK <> "B") Or (Text_AL <> "" And Text_AL <> "B") Or _ |
| (Text_AM <> "" And Text_AM <> "B") Or (Text_AN <> "" And Text_AN <> "B") Then |
| |
| .TypeText Text:="Besuchte Schulungen/Trainings:" |
| .TypeText Text:=vbTab 'Tabulator |
| .TypeText Text:="Schulungsdatum:" |
| .Font.Bold = False |
| .TypeParagraph: .TypeParagraph |
| |
| If Text_I <> "" And Text_I <> "B" Then |
| .TypeText Kurs_I & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_I |
| .TypeParagraph |
| End If |
| If Text_J <> "" And Text_J <> "B" Then |
| .TypeText Kurs_J & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_J |
| .TypeParagraph |
| End If |
| If Text_K <> "" And Text_K <> "B" Then |
| .TypeText Kurs_K & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_K |
| .TypeParagraph |
| End If |
| If Text_L <> "" And Text_L <> "B" Then |
| .TypeText Kurs_L & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_L |
| .TypeParagraph |
| End If |
| If Text_M <> "" And Text_M <> "B" Then |
| .TypeText Kurs_M & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_M |
| .TypeParagraph |
| End If |
| If Text_N <> "" And Text_N <> "B" Then |
| .TypeText Kurs_N & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_N |
| .TypeParagraph |
| End If |
| If Text_O <> "" And Text_O <> "B" Then |
| .TypeText Kurs_O & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_O |
| .TypeParagraph |
| End If |
| If Text_P <> "" And Text_P <> "B" Then |
| .TypeText Kurs_P & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_P |
| .TypeParagraph |
| End If |
| If Text_Q <> "" And Text_Q <> "B" Then |
| .TypeText Kurs_Q & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_Q |
| .TypeParagraph |
| End If |
| If Text_R <> "" And Text_R <> "B" Then |
| .TypeText Kurs_R & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_R |
| .TypeParagraph |
| End If |
| If Text_S <> "" And Text_S <> "B" Then |
| .TypeText Kurs_S & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_S |
| .TypeParagraph |
| End If |
| If Text_T <> "" And Text_T <> "B" Then |
| .TypeText Kurs_T & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_T |
| .TypeParagraph |
| End If |
| If Text_U <> "" And Text_U <> "B" Then |
| .TypeText Kurs_U & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_U |
| .TypeParagraph |
| End If |
| If Text_V <> "" And Text_V <> "B" Then |
| .TypeText Kurs_V & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_V |
| .TypeParagraph |
| End If |
| If Text_W <> "" And Text_W <> "B" Then |
| .TypeText Kurs_W & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_W |
| .TypeParagraph |
| End If |
| If Text_X <> "" And Text_X <> "B" Then |
| .TypeText Kurs_X & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_X |
| .TypeParagraph |
| End If |
| If Text_Y <> "" And Text_Y <> "B" Then |
| .TypeText Kurs_Y & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_Y |
| .TypeParagraph |
| End If |
| If Text_Z <> "" And Text_Z <> "B" Then |
| .TypeText Kurs_Z & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_Z |
| .TypeParagraph |
| End If |
| If Text_AA <> "" And Text_AA <> "B" Then |
| .TypeText Kurs_AA & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_AA |
| .TypeParagraph |
| End If |
| If Text_AB <> "" And Text_AB <> "B" Then |
| .TypeText Kurs_AB & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_AB |
| .TypeParagraph |
| End If |
| If Text_AC <> "" And Text_AC <> "B" Then |
| .TypeText Kurs_AC & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_AC |
| .TypeParagraph |
| End If |
| If Text_AD <> "" And Text_AD <> "B" Then |
| .TypeText Kurs_AD & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_AD |
| .TypeParagraph |
| End If |
| If Text_AE <> "" And Text_AE <> "B" Then |
| .TypeText Kurs_AE & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_AE |
| .TypeParagraph |
| End If |
| If Text_AF <> "" And Text_AF <> "B" Then |
| .TypeText Kurs_AF & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_AF |
| .TypeParagraph |
| End If |
| If Text_AG <> "" And Text_AG <> "B" Then |
| .TypeText Kurs_AG & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_AG |
| .TypeParagraph |
| End If |
| If Text_AH <> "" And Text_AH <> "B" Then |
| .TypeText Kurs_AH & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_AH |
| .TypeParagraph |
| End If |
| If Text_AI <> "" And Text_AI <> "B" Then |
| .TypeText Kurs_AI & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_AI |
| .TypeParagraph |
| End If |
| If Text_AJ <> "" And Text_AJ <> "B" Then |
| .TypeText Kurs_AJ & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_AJ |
| .TypeParagraph |
| End If |
| If Text_AK <> "" And Text_AK <> "B" Then |
| .TypeText Kurs_AK & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_AK |
| .TypeParagraph |
| End If |
| If Text_AL <> "" And Text_AL <> "B" Then |
| .TypeText Kurs_AL & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_AL |
| .TypeParagraph |
| End If |
| If Text_AM <> "" And Text_AM <> "B" Then |
| .TypeText Kurs_AM & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_AM |
| .TypeParagraph |
| End If |
| If Text_AN <> "" And Text_AN <> "B" Then |
| .TypeText Kurs_AN & ":" |
| .TypeText Text:=vbTab |
| .TypeText Text_AN |
| .TypeParagraph |
| End If |
| |
| .TypeParagraph |
| |
| Else |
| .Font.Bold = True |
| .TypeText Text:="Besuchte Schulungen/Trainings:" |
| .TypeParagraph: .TypeParagraph |
| .TypeText "- - - k e i n e - - -" |
| .Font.Bold = False |
| .TypeParagraph: .TypeParagraph |
| End If |
| |
| '******************************************************** |
|
| 'Bereich "Trainingsbedarf" |
| If Text_I = "B" Or Text_J = "B" Or _ |
| Text_K = "B" Or Text_L = "B" Or _ |
| Text_M = "B" Or Text_N = "B" Or _ |
| Text_O = "B" Or Text_P = "B" Or _ |
| Text_Q = "B" Or Text_R = "B" Or _ |
| Text_S = "B" Or Text_T = "B" Or _ |
| Text_U = "B" Or Text_V = "B" Or _ |
| Text_V = "B" Or Text_X = "B" Or _ |
| Text_Y = "B" Or Text_Z = "B" Or _ |
| Text_AA = "B" Or Text_AB = "B" Or _ |
| Text_AC = "B" Or Text_AD = "B" Or _ |
| Text_AE = "B" Or Text_AF = "B" Or _ |
| Text_AG = "B" Or Text_AH = "B" Or _ |
| Text_AI = "B" Or Text_AJ = "B" Or _ |
| Text_AK = "B" Or Text_AL = "B" Or _ |
| Text_AM = "B" Or Text_AN = "B" Then |
| |
| .Font.Bold = True |
| .TypeText Text:="Trainingsbedarf:" |
| .TypeParagraph: .TypeParagraph |
| .Font.Bold = False |
| |
| If Text_I = "B" Then |
| .TypeText Kurs_I |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_J = "B" Then |
| .TypeText Kurs_J |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_K = "B" Then |
| .TypeText Kurs_K |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_L = "B" Then |
| .TypeText Kurs_L |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_M = "B" Then |
| .TypeText Kurs_M |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_N = "B" Then |
| .TypeText Kurs_N |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_O = "B" Then |
| .TypeText Kurs_O |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_P = "B" Then |
| .TypeText Kurs_P |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_Q = "B" Then |
| .TypeText Kurs_Q |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_R = "B" Then |
| .TypeText Kurs_R |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_S = "B" Then |
| .TypeText Kurs_S |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_T = "B" Then |
| .TypeText Kurs_T |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_U = "B" Then |
| .TypeText Kurs_U |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_V = "B" Then |
| .TypeText Kurs_V |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_W = "B" Then |
| .TypeText Kurs_W |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_X = "B" Then |
| .TypeText Kurs_X |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_Y = "B" Then |
| .TypeText Kurs_Y |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_Z = "B" Then |
| .TypeText Kurs_Z |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_AA = "B" Then |
| .TypeText Kurs_AA |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_AB = "B" Then |
| .TypeText Kurs_AB |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_AC = "B" Then |
| .TypeText Kurs_AC |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_AD = "B" Then |
| .TypeText Kurs_AD |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_AE = "B" Then |
| .TypeText Kurs_AE |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_AF = "B" Then |
| .TypeText Kurs_AF |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_AG = "B" Then |
| .TypeText Kurs_AG |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_AH = "B" Then |
| .TypeText Kurs_AH |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_AI = "B" Then |
| .TypeText Kurs_AI |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_AJ = "B" Then |
| .TypeText Kurs_AJ |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_AK = "B" Then |
| .TypeText Kurs_AK |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_AL = "B" Then |
| .TypeText Kurs_AL |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_AM = "B" Then |
| .TypeText Kurs_AM |
| .TypeParagraph |
| Training = "x" |
| End If |
| If Text_AN = "B" Then |
| .TypeText Kurs_AN |
| .TypeParagraph |
| Training = "x" |
| End If |
| End If |
| |
| '******************************************************** |
| |
| If (Text_I <> "" And Text_I <> "B") And (Text_J <> "" And Text_J <> "B") And _ |
| (Text_K <> "" And Text_K <> "B") And (Text_L <> "" And Text_L <> "B") And _ |
| (Text_M <> "" And Text_M <> "B") And (Text_N <> "" And Text_N <> "B") And _ |
| (Text_O <> "" And Text_O <> "B") And (Text_P <> "" And Text_P <> "B") And _ |
| (Text_Q <> "" And Text_Q <> "B") And (Text_R <> "" And Text_R <> "B") And _ |
| (Text_S <> "" And Text_S <> "B") And (Text_T <> "" And Text_T <> "B") And _ |
| (Text_U <> "" And Text_U <> "B") And (Text_V <> "" And Text_V <> "B") And _ |
| (Text_W <> "" And Text_W <> "B") And (Text_X <> "" And Text_X <> "B") And _ |
| (Text_Y <> "" And Text_Y <> "B") And (Text_Z <> "" And Text_Z <> "B") And _ |
| (Text_AA <> "" And Text_AA <> "B") And (Text_AB <> "" And Text_AB <> "B") And _ |
| (Text_AC <> "" And Text_AC <> "B") And (Text_AD <> "" And Text_AD <> "B") And _ |
| (Text_AE <> "" And Text_AE <> "B") And (Text_AF <> "" And Text_AF <> "B") And _ |
| (Text_AG <> "" And Text_AG <> "B") And (Text_AH <> "" And Text_AH <> "B") And _ |
| (Text_AI <> "" And Text_AI <> "B") And (Text_AJ <> "" And Text_AJ <> "B") And _ |
| (Text_AK <> "" And Text_AK <> "B") And (Text_AL <> "" And Text_AL <> "B") And _ |
| (Text_AM <> "" And Text_AM <> "B") And (Text_AN <> "" And Text_AN <> "B") Then |
| |
| .Font.Bold = True |
| .TypeText Text:="Trainingsbedarf:" |
| .TypeParagraph: .TypeParagraph |
| .TypeText "- - - Alle Schulungsmaßnahmen absolviert - - -" |
| .Font.Bold = False |
| |
| ElseIf Training = "" Then |
| |
| .Font.Bold = True |
| .TypeText Text:="Trainingsbedarf:" |
| .TypeParagraph: .TypeParagraph |
| .TypeText "- - - Keine Schulungsmaßnahmen vorgesehen - - -" |
| .Font.Bold = False |
| End If |
|
| End With |
| End Function |
|
zurück