Verbesserung für Modul

[Micharius]

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.

Code [Auswählen] Erweitern

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 Sub

Es 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 

Sonnige Grüsse

Micharius




[/list]

[Beaker s.a.]

Hallo Micharius,

•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).

•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:

Code [Auswählen] Erweitern


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

[Beaker s.a.]

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.

Code [Auswählen] Erweitern

Dim fld As DAO.Field
For Each fld In rsBesuchsplanGrunddaten.Fields
    .ActiveDocument.Bookmarks(fld.Name).Select
    .Selection.Text = Nz(rsBesuchsplanGrunddaten(fld.Name), "")
Next fld

[Micharius]

Ja Hallo! Also nicht wahr, die Sache ist so ;-)

Das Befüllen der einzelnen Bookmarks in diesem Bereich des Code funktioniert wunderbar:

Code [Auswählen] Erweitern

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'

Code [Auswählen] Erweitern

            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?

Code [Auswählen] Erweitern

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

[PhilS]

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:

Code [Auswählen] Erweitern

   
            'Vorlage als Dokument öffnen
            .Documents.Add Template:=strDocVorlage
           
           ' Name der aktiven Vorlage zwischenspeichern
            Set wdDoc = .ActiveDocument
           

Besser nur diese Zeile:

Code [Auswählen] Erweitern

            '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.

[DF6GL]

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),""))

[Lachtaube]

Ich fasse mal grob (ohne Fehlerbehandlung) zusammen:

Code [Auswählen] Erweitern

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

[Beaker s.a.]

Hallo,
Dem kann ich wohl kaum noch was hinzufügen, ausser vielleicht

Code [Auswählen] Erweitern

'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

[Micharius]

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