Λοιπόν κοίτα το παρακάτω κωδικα. Πρέπει για να δουλέψει να έχεις κάνεις reference τη Microsoft word object library (στον VBAeditor:Tools-references)
Παίρνω ένα πίνακα τον φορτώνω σε ένα recordset και μετά μια μια εγγραφή γράφω σε word table.
Αντί για πίνακα μπορείς να βάλεις και query βέβαια και με τον μηχανισμό που σε περίγραψα παραπάνω μπορείς να βρεις και τις άλλες ιδιότητες του πίνακα στο word.
Private Sub WordExport_Click()
Dim AccessTbl As Recordset 'Ο πίνακας που αποθηκεύει τα δεδομένα
Dim ObjWordApp As Word.Application
Dim ObjWord As Word.Document
Dim oSel As Word.Selection
Dim oTable As Word.Table
'δώσε όνομα στον πίνακα της Access
Set AccessTbl = CurrentDb.OpenRecordset("mytable")
'όρισε την εφαρμογή Word και άνοιξε το έγγραφο που διάλεξες παραπάνω
Set ObjWordApp = CreateObject("Word.Application")
Set ObjWord = ObjWordApp.Documents.Add
ObjWord.Activate
'απενεργοποίησε τις προειδοποιήσεις στο Word
ObjWordApp.DisplayAlerts = False
'όρισε τον Δρομέα Επιλογής
Set oSel = ObjWord.Application.Selection
'page setup
With ObjWord.PageSetup
.TopMargin = CentimetersToPoints(0.5)
.BottomMargin = CentimetersToPoints(0.3)
.LeftMargin = CentimetersToPoints(0.5)
.RightMargin = CentimetersToPoints(0.5)
End With
'απενεργοποίησε τον ορθογραφικό έλεγχο
With ObjWord.Application.Options
.CheckSpellingAsYouType = False
.CheckGrammarAsYouType = False
.SuggestSpellingCorrections = False
End With
'δημιουργησε τον πίνακα στο Word με αριθμό σειρών όσa και τα records του πινακα
Set oTable = ObjWord.Tables.Add(ObjWord.Range(0, 0), AccessTbl.RecordCount, 2)
'μορφοποίηση πίνακα, στηλών και κελιών
oTable.Select
With oSel
.Cells.SetHeight RowHeight:=CentimetersToPoints(3.6), HeightRule:=wdRowHeightExactly
.Cells.VerticalAlignment = wdCellAlignVerticalCenter
.Cells.Borders(wdBorderLeft).LineStyle = wdLineStyleSingle
.Cells.Borders(wdBorderRight).LineStyle = wdLineStyleSingle
.Cells.Borders(wdBorderTop).LineStyle = wdLineStyleSingle
.Cells.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
.Font.Name = "Arial"
.Font.Size = 16
.ParagraphFormat.Alignment = wdAlignParagraphCenter
End With
With oTable.Columns(1)
.SetWidth ColumnWidth:=CentimetersToPoints(9.5), RulerStyle:=wdAdjustNone
.Select
End With
oSel.ParagraphFormat.Alignment = wdAlignParagraphCenter
With oTable.Columns(2)
.SetWidth ColumnWidth:=CentimetersToPoints(9.5), RulerStyle:=wdAdjustNone
.Select
End With
oSel.ParagraphFormat.Alignment = wdAlignParagraphCenter
'διάλεξε το πρώτο κελί
oTable.Cell(1, 1).Select
On Error Resume Next 'για να μην κολλησει στη τελευταία εγγραφή
'γράψε σε κάθε κελί του πίνακα του Word τα στοιχεία από τον πίνακα της Access
AccessTbl.MoveFirst
Do Until AccessTbl.EOF
oSel.TypeText Text:="" & AccessTbl.Fields(0).Value & ""
oSel.MoveRight unit:=wdCell
oSel.TypeText Text:="" & AccessTbl.Fields(1).Value & ""
oSel.MoveRight unit:=wdCell
AccessTbl.MoveNext
Loop
ObjWord.SaveAs ("c:\1.doc")
ObjWord.Close (True) 'κλείσε σώζοντας τις αλλαγές
ObjWordApp.Quit 'κλείσε το Word
Set ObjWordApp = Nothing
Set ObjWord = Nothing
Set oSel = Nothing
Set oTable = Nothing
End Sub
Manos