'*** Im Array feld werden die Namen der Tabellenfelder aus der ersten Tabellenzeile gespeichert.
' Der Wert 15 kann bei Bedarf geändert werden.
'	
Dim feld(1 to 15) as String
'
'*** In Eintrag werden die Serienbriefdaten gespeichert. Passen Sie den Wert 15 entsprechend der Dimensionierung in feld an,
' den Wert 20 egemäß der maximalzahl der zu erzeugenden Serienbriefe.
'
	Dim eintrag(1 to 15, 1 to 20) as String
'
'*** Vorlage enthält später die zu nutzende Briefvorlage
'
	Dim Vorlage as String
'
' Das sind im Programm genutzte Hilfsvariable
'
	Dim i, k, l, fallzahl, feldzahl as Integer
'
'*** Die Objectvariablen für Textmaker und Planmaker
'
	Dim tm, pm as Object

Sub auswahl
'
'*************************************************** Briefvorlage erzeugen
'
Dim fs, dr as object
Dim pfad, Dateiname as string
'
'*** Im Array templ werden später die Namen der Vorlagen gesichert. 
'Wenn Sie mehr als 10 Vorlagen haben/anzeigen wollen, muss der Wert erhöht werden
'
Dim templ(10) as String
Dim laenge as integer
Set tm = CreateObject("TextMaker.Application")
tm.Application.Visible = True
tm.Activate
'
'*** Der Vorlagenpfad wird aus Textmaker ausgelesen
'
pfad = tm.Application.Options.DefaultTemplatePath & "\Deutsch\Brief\"
laenge = len(pfad)
Set fs = CreateObject("Scripting.FileSystemObject")
i=1
Set dr = fs.GetFolder(pfad)
'
'*** Alle Vorlagen werden ausgelesen, nur die Namen ohne Pfad werden im Array templ gesichert.
'
For each dateiname in dr.files
	templ(i) = Mid(Dateiname, laenge)
	i = i+1
next dateiname
'
'*** Definition des Auswahldialogs für die Vorlagen
'

Begin Dialog DIALOG_1 147,54, 117, 117, "Vorlagen"
  ListBox 8,16,96,72, templ(), .ListBox_1
  Text 8,4,140,8, "Wählen Sie eine Briefvorlage aus:"
  OKButton 8,92,52,20
End Dialog
'
'*** Dialog anzeigen, ausgewälte Vorlage speichern
'
Dim DLG as Dialog_1
button = Dialog(DLG)
Vorlage = templ(DLG.ListBox_1 + 1)
'
'*************************************************** Ermittle die Anzahl und Namen der Datenfelder aus Planmaker
'
	Set pm = CreateObject("PlanMaker.Application")
	pm.Application.Visible = True
	pm.Activate
	feldzahl=1

	Do While pm.ActiveSheet.Rows(1).Columns(feldzahl).Value <> "" AND Feldzahl < 11	' Solange ein Text gelesen und die Anzahl der Felder < 11 ist
		feld(feldzahl) = pm.ActiveSheet.Rows(1).Columns(feldzahl).Value ' Text im array feld speichern
		feldzahl = feldzahl+1
	Loop
	feldzahl = feldzahl-1
'
'*************************************************** Hole die Anzahl und Daten der ausgewählten Datensätze
'
	k = 2
	fallzahl = 0
	Do While pm.ActiveSheet.Rows(k).Columns(2).Value <> "" 'Solange in einer Zeile, erste Spalte Text steht
		if pm.ActiveSheet.Rows(k).Columns(1).Font.BColor <> -1 Then ' Wenn dort der Texthintergrund nicht Transparent ist
			fallzahl = fallzahl + 1
			For i= 1 to feldzahl
				eintrag(i,fallzahl) = pm.ActiveSheet.Rows(k).Columns(i).Value ' Lese nacheinander alle Felder des Datensatzes uns speicher das im Array eintrag
			Next
		End If
		k = k+1
	Loop
	Schreibe '**************************************** Rufe das Unterprogramm Briefe schreiben
 	Set tm = Nothing
	Set pm = Nothing

End Sub

Sub Schreibe
'*************************************************** Briefvorlage in Textmaker aktivieren und mit Daten füllen
	tm.Application.Visible = True
	tm.WindowState = tmWindowStateMaximize
	tm.Activate
	Vorlage = tm.Application.Options.DefaultTemplatePath & "\Deutsch\Brief\" & Vorlage
	For l= 1 to fallzahl
		tm.Documents.Add (Vorlage) ' Erzeuge für jeden Fall ein neues TM-Dokoment mit der Vorlage
 		pc = tm.ActiveDocument.FormFields.Count 'Ermittle die Anzahl der in der Vorlage enthaltenen Textfelder
		For i=1 to pc 'Für jedes Textfeld
			For k= 1 to feldzahl 'Für jedes Datenfeld des Datensatzes
				If tm.ActiveDocument.FormFields.Item(i).Name = feld(k) Then 'Wenn dem Textfeld ein Datendfeld entspricht
					tm.ActiveDocument.FormFields(i).TextInput.Text = eintrag(k,l) ' Fülle das Textfeld mit dem entsprechenden Eintrag des Datensatzes
				End If
			Next 'Nächstes Textfeld
		Next 'Nächstes Datenfeld
	Next 'Nächstes Dokument
End Sub	 
 
