Hallo und guten Abend
Meinem Post von heute morgen folgend, habe ich mir aus einer Beispielsdatenbank einen Code zusammengeschustert. Er öffnet eine Word Vorlage, und füllt Textmarken mit Daten aus und füllt zusätzlich Werte aus einer Tabelle in eine Wordtabelle.
Option Compare Database
Option Explicit
Sub WordBesuchsplanFuellen(Optional lngDatensatzID As Long)
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdRange As Range
Dim wdZeile As Row
Dim strDocVorlage As String
Dim sAktiv 'um das aktive Dokument anzusteuern
Dim sVorlage 'um die Serienbrief-Vorlage anzusteuern
Dim db As DAO.Database
Dim rsBesuchsplanGrunddaten As DAO.Recordset
Dim rsTabelle As DAO.Recordset
Dim i As Long
Dim j As Long
Dim lngAnzZeilenInTabelle As Long
strDocVorlage = p_c_LokalerPfadAccess & "\Besuchsplan.dotx"
'Neue Instanz von Word aufrufen
Set wdApp = CreateObject("Word.Application")
With wdApp
.Visible = True
Set db = CurrentDb
Set rsBesuchsplanGrunddaten = db.OpenRecordset("Select * FROM qryBesExportdatenFuerWord Where BesID =" & lngDatensatzID, dbOpenSnapshot)
i = 2 'Tabellenzeile für Eintrag
'Vorlage als Dokument öffnen
.Documents.Add Template:=strDocVorlage
' Name der aktiven Vorlage zwischenspeichern
Set wdDoc = .ActiveDocument
sVorlage = .ActiveDocument.Name
'Daten für die Tabelle holen
Set rsTabelle = db.OpenRecordset("Select * FROM tblZiele WHERE ZielBesIDRef =" & lngDatensatzID)
rsTabelle.MoveLast
lngAnzZeilenInTabelle = rsTabelle.RecordCount ' Anzahl Ereignisse für Zeilenanzahl Tabelle
'Tabelle hat Textmarke 'XTabelle'
Set wdRange = wdDoc.Range(wdDoc.Bookmarks("XTabelle").Start, _
wdDoc.Bookmarks("XTabelle").End)
For j = 1 To lngAnzZeilenInTabelle - 1
wdRange.Rows.Add ' Zeilen anfügen
Next j
rsTabelle.MoveFirst
'Tabelle füllen
Do While Not rsTabelle.EOF
For j = 1 To 8 'Anzahl Felder die abgefüllt werden sollen
'Tabelle ist die zweite im Hauptdokument - Index = 2
.ActiveDocument.Tables(2).Rows(i).Cells(j).Range = rsTabelle(j - 1)
Next j
i = i + 1
rsTabelle.MoveNext
Loop
rsTabelle.Close
'Ausfüllen der Textmarken
.ActiveDocument.Bookmarks("KunName").Select
.Selection.Text = Nz(rsBesuchsplanGrunddaten("KunName"), "")
.ActiveDocument.Bookmarks("KunAdresse").Select
.Selection.Text = Nz(rsBesuchsplanGrunddaten("KunAdresse"), "")
.ActiveDocument.Bookmarks("KonNameVorname").Select
.Selection.Text = Nz(rsBesuchsplanGrunddaten("KonNameVorname"), "")
.ActiveDocument.Bookmarks("KonMail").Select
.Selection.Text = Nz(rsBesuchsplanGrunddaten("KonMail"), "")
.ActiveDocument.Bookmarks("Verteiler").Select
.Selection.Text = Nz(rsBesuchsplanGrunddaten("Verteiler"), "")
wdApp.Activate
End With
rsBesuchsplanGrunddaten.Close
ExitFunction:
Set wdZeile = Nothing
Set wdRange = Nothing
Set wdDoc = Nothing
Set wdApp = Nothing
Set rsTabelle = Nothing
Set rsBesuchsplanGrunddaten = Nothing
Set db = Nothing
Exit Sub
End SubEs gibt aber Sachen, die ich beim Tabellenabfüllen verbessern möchte - vielleicht kann mir jemand einen Tipp geben:
- Felder mit NULL Werten generieren momentan noch eine Fehlermeldung beim Abfüllen in die Word Tabelle. Wie könnte ich diese vermeiden?
- Die Anzahl zu abfüllenden Felder ist ja momentan noch hardcodiert 8 - wie könnte ich es machen, dass jeweils alle Felder eines Datensatzes in die Tabelle gespitzt werden
Generelle Codeverbesserungen nehme ich natürlich auch gerne entgegen :-X
Sonnige Grüsse
Micharius
[/list]
Hallo Micharius,
Zitat•Felder mit NULL Werten generieren momentan noch eine Fehlermeldung beim Abfüllen in die Word Tabelle. Wie könnte ich diese vermeiden?
Welchen Fehler? Normal sollte Nz genügen, aber vielleicht vertragen die
Bookmarks keinen Leerstring (mit Word kenn ich mich nun so gar nicht
aus).
Zitat•Die Anzahl zu abfüllenden Felder ist ja momentan noch hardcodiert 8 - wie könnte ich es machen, dass jeweils alle Felder eines Datensatzes in die Tabelle gespitzt werden
Wie du siehst hat das .ActiveDokument eine Auflistung "Bookmarks".
Diese könntest in einer For...Each-Schleife durchlaufen.
Luftcode:
Dim bm As Word.Bookmark
For Each bm in .ActiveDocument.Bookmarks
.ActiveDocument.Bookmarks(bm.Name).Select
.Selection.Text = Nz(rsBesuchsplanGrunddaten(bm.Name), "")
Next bm
(unter der Voraussetzung, dass Bookmark und Feld immer den gleichen
Namen haben)
@Regulars
Wer besser mit Word auskennt möge mich bitte korrigieren, danke.
gruss ekkehard
Fällt mir gerade noch was ein. Wenn das RS nur Felder für die
Bookmarks hat, könnte man es auch andersrum versuchen, da
sollten dann die nicht bedienten Bookmarks einfach leer bleiben.
Dim fld As DAO.Field
For Each fld In rsBesuchsplanGrunddaten.Fields
.ActiveDocument.Bookmarks(fld.Name).Select
.Selection.Text = Nz(rsBesuchsplanGrunddaten(fld.Name), "")
Next fld
Ja Hallo! Also nicht wahr, die Sache ist so ;-)
Das Befüllen der einzelnen Bookmarks in diesem Bereich des Code funktioniert wunderbar:
Ausfüllen der Textmarken
.ActiveDocument.Bookmarks("KunName").Select
.Selection.Text = Nz(rsBesuchsplanGrunddaten("KunName"), "")
.ActiveDocument.Bookmarks("KunAdresse").Select
.Selection.Text = Nz(rsBesuchsplanGrunddaten("KunAdresse"), "")
.ActiveDocument.Bookmarks("KonNameVorname").Select
.Selection.Text = Nz(rsBesuchsplanGrunddaten("KonNameVorname"), "")
.ActiveDocument.Bookmarks("KonMail").Select
.Selection.Text = Nz(rsBesuchsplanGrunddaten("KonMail"), "")
.ActiveDocument.Bookmarks("Verteiler").Select
.Selection.Text = Nz(rsBesuchsplanGrunddaten("Verteiler"), "")
wdApp.Activate
End With
Das Problem habe ich beim Ausfüllen der Tabelle. Ein einziges Bookmark dient dort nur als Startmarke, eingefüllt wird dann vom Makro selbst:
'Tabelle hat Textmarke 'XTabelle'
Set wdRange = wdDoc.Range(wdDoc.Bookmarks("XTabelle").Start, _
wdDoc.Bookmarks("XTabelle").End)
For j = 1 To lngAnzZeilenInTabelle - 1
wdRange.Rows.Add ' Zeilen anfügen
Next j
rsTabelle.MoveFirst
'Tabelle füllen
Do While Not rsTabelle.EOF
For j = 1 To 8 'Anzahl Felder die abgefüllt werden sollen
'Tabelle ist die zweite im Hauptdokument - Index = 2
.ActiveDocument.Tables(2).Rows(i).Cells(j).Range = rsTabelle(j - 1)
Next j
i = i + 1
rsTabelle.MoveNext
Loop
rsTabelle.Close
Felder aus dem Datensatz, die NULL sind erzeugen die Fehlermeldung "Laufzeitfehler 94: Unzulässige Verwendung von Null"
Aber da werde ich wohl mit einer If/Then arbeiten müssen, um allfällige Nullfelder vor dem Befüllen in 0 umzuwandeln?
Do While Not rsTabelle.EOF
For j = 1 To 8 'Anzahl Felder die abgefüllt werden sollen
'Tabelle ist die zweite im Hauptdokument - Index = 2
.ActiveDocument.Tables(2).Rows(i).Cells(j).Range = rsTabelle(j - 1)
Hier sind die Anzahl Felder, bzw. Spalten in der Tabelle definiert, die eingetragen werden. Werde versuchen, diese mittels rsTabelle.fields.count zu ermitteln - geht leider erst am Montag, da ich die DB bei der Arbeit habe.
Was mich aber noch fordert: Ich sollte zig verschiedene Tabellen in einem Wordfile befüllen. Jedesmal das ganze zu codieren stresst. So sollte ich wohl den ganzen Teil in eine neue Sub auslagern, und jeweils mit den entsprechenden Parametern aufrufen. Aber das könnte dann ein neues Posting sein...
Sonnige Grüsse
Micharius
Ich habe kein Input zur konkreten Problemstellung, aber ich sehe in dem Code ein häufig aufkommendes Problem, dass ich ansprechen möchte.
Du verwendest mehrfach
.ActiveDocument um das aktuelle Dokument zu referenzieren. Dass dies langsam ist, ist eher ein untergeordnetes Problem, aber wenn es der Benutzer schafft, während der Laufzeit deines Codes in Word herumzuklicken und das Dokument zu wechseln, dann liefert die
.ActiveDocument das falsche Dokument. - Das ist in der Praxis sehr, sehr unwahrscheinlich, aber nicht unmöglich.
Also, anstelle von diesem Konstrukt:
Zitat von: Micharius am Juni 22, 2018, 15:24:14
'Vorlage als Dokument öffnen
.Documents.Add Template:=strDocVorlage
' Name der aktiven Vorlage zwischenspeichern
Set wdDoc = .ActiveDocument
Besser nur diese Zeile:
'Vorlage als Dokument öffnen und in wdDoc speichern
Set wdDoc = .Documents.Add (Template:=strDocVorlage)Sämtliche nachfolgende Referenzen auf
.ActiveDocument ersetzt du dann durch
wdDoc.
Hallo,
warum benutzt Du dann nicht die nz()-Funktion??
wdDoc.Tables(2).Rows(i).Cells(j).Range = nz(rsTabelle(j - 1),"")
Oftmals hab ich bemerkt, dass manche Word(Outlook,Excel) -Objekte keinen Variant bei der Zuweisung mögen. Dann hilft, die Variant-Variable explicit in den entspr. Datentyp zu konvertieren (was hier in diesem Fall aber nicht nötig sein sollte):
wdDoc.Tables(2).Rows(i).Cells(j).Range = CStr(nz(rsTabelle(j - 1),""))
Ich fasse mal grob (ohne Fehlerbehandlung) zusammen:Public Sub WordBesuchsplanFuellen(VorlagePfad As String, ByVal BesucherId As Long)
Dim db As DAO.Database
Dim rsG As DAO.Recordset 'Grunddaten
Dim rsZ As DAO.Recordset 'Zieldaten
Dim numZRows As Long
Dim i As Long
Dim j As Long
Const QRY_G As String = _
"Select * FROM qryBesExportdatenFuerWord Where BesID=[@ID]"
Const QRY_Z As String = _
"Select * FROM tblZiele WHERE ZielBesIDRef=[@ID]"
Set db = CurrentDb
With db.CreateQueryDef(vbNullString, QRY_G)
.Parameters("@ID") = BesucherId
Set rsG = .OpenRecordset(dbOpenSnapshot)
End With
With db.CreateQueryDef(vbNullString, QRY_Z)
.Parameters("@ID") = BesucherId
Set rsZ = .OpenRecordset(dbOpenSnapshot)
End With
'unzureichende Daten?
'... Then Exit Sub 'genügt auch. Access schließt auch dann die beiden Recordsets
If rsG.RecordCount = 0 Or rsZ.RecordCount = 0 Then GoTo ExitFunction
rsZ.MoveLast
numZRows = rsZ.RecordCount 'Anzahl der Datenzeilen
rsZ.MoveFirst
'Neue Word-Instanz anlegen
With New Word.Application
'Word-Dokument aus Vorlage erstellen
With .Documents.Add(VorlagePfad)
'Tabelle besitzt Textmarke 'XTabelle'
With .Range(.Bookmarks("XTabelle").Start, .Bookmarks("XTabelle").End)
' Zeilen anfügen
For j = 1 To numZRows - 1: .Rows.Add: Next
End With
'Tabelle füllen
i = 2 'Tabellenzeile für 1. Eintrag
Do Until rsZ.EOF
For j = 1 To 8 'Anzahl Felder die abgefüllt werden sollen
'2. Tabelle im Hauptdokument
.Tables(2).Rows(i).Cells(j).Range = Nz(rsZ(j - 1))
Next
i = i + 1
rsZ.MoveNext
Loop
'Ausfüllen der Textmarken
With .Bookmarks
.Item("KunName").Range = Nz(rsG("KunName"))
.Item("KunAdresse").Range = Nz(rsG("KunAdresse"))
.Item("KonNameVorname").Range = Nz(rsG("KonNameVorname"))
.Item("KonMail").Range = Nz(rsG("KonMail"))
.Item("Verteiler").Range = Nz(rsG("Verteiler"))
End With
End With 'Document
.Visible = True
.Activate
End With 'Application
ExitFunction:
rsZ.Close
rsG.Close
End Sub
Hallo,
Dem kann ich wohl kaum noch was hinzufügen, ausser vielleicht
'Tabelle füllen
i = 2 'Tabellenzeile für 1. Eintrag
Do Until rsZ.EOF
For j = 0 To rsZ.Fields.Count - 1 'Anzahl Felder die abgefüllt werden sollen
'2. Tabelle im Hauptdokument
.Tables(2).Rows(i).Cells(j+1).Range = Nz(rsZ(j)) '<-- !!!
Next
i = i + 1
rsZ.MoveNext
Loop
Wenn's denn etwas flexibler sein darf ;)
gruss ekkehard
Cool Leute, vielen Dank! Das hilft mir sehr weiter!
Herzliche Grüsse und ich wünsche euch noch einen guten Sonntagabend!
Herzliche Grüsse
Micharius