Office Forum

Code: Alles auswählen

Sub testen()
    Dim cn As Object
    Dim rs As Object
    Set cn = CreateObject("ADODB.Connection")
    cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Daten\simpleDatenbank.accdb; Persist Security Info=False;"
    cn.Open
   
    Set rs = cn.Execute("SELECT * FROM EinzigeTabelle")
    rs.movefirst
    Dim i As Long
    Dim WdDoc As Object
    Set WdDoc = GetObject(, "Word.Application").Documents.Add("C:\Daten\MeineVorlage.dotx")
    For i = 0 To rs.Fields.Count - 1
        WdDoc.tables(1).Rows(1).Cells(i + 1) = rs.Fields(i).Name
        WdDoc.tables(1).Rows(2).Cells(i + 1) = rs.Fields(i).Value
    Next i
    rs.movenext
   
    Do While Not rs.EOF
        With WdDoc.tables(1).Rows.Add()
            For i = 0 To rs.Fields.Count - 1
                .Cells(i + 1) = rs.Fields(i).Value
            Next i
        End With
        rs.movenext
    Loop
End Sub

Video bietet eine leistungsstarke Möglichkeit - zur Unterstützung Ihres Standpunkts.

Code: Alles auswählen

Video
bietet
eine
leistungsstarke
Möglichkeit
-
zur
Unterstützung
Ihres
Standpunkts
.



Code: Alles auswählen

' In letzte Zeile positionieren, Zelle mit Textmarke Spalte3 löschen
                  .GoTo What:=wdGoToBookmark, Name:="Spalte3"   'gehe zu Tabellenstelle mit der Textmarke
                  .SelectRow                                                            ' Zeile Markieren
                  .Delete Unit:=wdWord, Count:=2                            ' Zelle leeren

Code: Alles auswählen

 
Private Sub Befehl8_Click()
'Knopf Print to KMED
' Wordfile öffnen und Tabelle füllen, variabel viele Zeilen
 
     Const Vorlage = "C:\Temp\test.docx"
     
     Dim DocType As String
     DocType = Me.ID_DocType

MsgBox (DocType)

     Dim NeueZeile As Boolean
     Dim dbs As DAO.Database
     Dim rs As DAO.Recordset
     Dim wdApp As Object ' Word.Application
     Dim wdDoc As Object ' Word.Document
     
     Const wdWord As Variant = 2              'Variablendeklaration für das löschen des Tabelleninhaltes der neu erstellen Tabellenzelle
     'Const wdcharacter As Long = 1           'Variablendeklaration für das löschen des Tabelleninhaltes der neu erstellen Tabellenzelle
     Const wdGoToBookmark As Long = -1   'Variablendeklaration für bookmark
     
     Set dbs = CurrentDb
     Set rs = dbs.OpenRecordset("SELECT * FROM qry_Checkpoints_fuer_Details WHERE DocType_ID =" & DocType) 'Variable &DocType wird durch die Suche (oben) übergeben
     
     On Error Resume Next
        Set wdApp = GetObject(, "Word.Application")
        If wdApp Is Nothing Then Set wdApp = CreateObject("Word.Application")
     On Error GoTo 0
        wdApp.Visible = True ' zum testen
        Set wdDoc = wdApp.Documents.Add(Vorlage)
     While rs.EOF <> True
         If NeueZeile Then
         
             With wdApp.Selection
                ' In letzte Zeile positionieren, Zelle mit Textmarke Spalte1 löschen
                  .GoTo What:=wdGoToBookmark, Name:="Spalte1"    'gehe zu Tabellenstelle mit der Textmarke
                  .SelectRow                                                              ' Zeile Markieren
                  .Copy                                                                      ' Zeile Kopieren
                  .Paste                                                                     ' Zeile einfügen
                  .Delete Unit:=wdWord, Count:=2                             ' Zeile leeren
                 
                 ' In letzte Zeile positionieren, Zelle mit Textmarke Spalte2 löschen
                  .GoTo What:=wdGoToBookmark, Name:="Spalte2"       'gehe zu Tabellenstelle mit der Textmarke
                  .SelectRow                                                                 ' Zeile Markieren
                  .Delete Unit:=wdWord, Count:=2                                 ' Zelle leeren
                 
                 ' In letzte Zeile positionieren, Zelle mit Textmarke Spalte3 löschen
                  .GoTo What:=wdGoToBookmark, Name:="Spalte3"   'gehe zu Tabellenstelle mit der Textmarke
                  .SelectRow                                                            ' Zeile Markieren
                  .Delete Unit:=wdWord, Count:=2                            ' Zelle leeren
                 
             End With
         End If
         
         wdDoc.Bookmarks("Spalte1").Range = rs!Topic
         wdDoc.Bookmarks("Spalte2").Range = rs!SubTopic
         wdDoc.Bookmarks("Spalte3").Range = rs!Description
         'wdDoc.Bookmarks("Spalte4").Range = rs!DocTypeRelativeComment
         NeueZeile = True
         rs.MoveNext
     Wend
     'wdDoc.SaveAs "Speicherplatz"
     'wdDoc.Close
     'wdApp.Quit
     Set wdDoc = Nothing
     Set wdApp = Nothing
     
 End Sub