Export querydef from Access to VBA to Word (1 Viewer)

M

mor

Registered User.
Local time
Tomorrow, 00:12
Joined
Jun 28, 2013
Messages
56
Hi Everyone!

I have a rather complicated query which in essence takes a pass through query, writes the query to a VBA matrix, manipulates the data and then exports it to word as an invoice.

Now here's my problem. Currently I have created a word document with built in bookmarks that allow the information to be added. The VBA code finds this document and then adds the relevant pieces of information using the 'insertafter' function. The problem is that the data set is dynamic and contains lots of different companies.

Therefore, I have a different page with numbered bookmarks within this document for each company.

What I would like to know is if it's possible to create the bookmarks and template within word and then add the information. I've tried this for days but some of the references in the Word object library don't exist when I try to write them from VBA for access? The code for writing to the current template is below for FYI.

As far as I know, its pretty much impossible to create a reference system in Word any other way!

Any help would be greatly appreciated!

Code: 
Dim Mat_Bij As Variant
Dim m As Integer
ReDim Mat_Bij(1 To DealCount, 1 To 5)

m = 1
    For k = LBound(Mat_Aij) To UBound(Mat_Aij)
 
        If k < UBound(Mat_Aij) Then
            If Mat_Aij(k, 1) <> Mat_Aij(k + 1, 1) Then
                Mat_Bij(m, 1) = Mat_Aij(k, 1)
                Mat_Bij(m, 2) = Mat_Aij(k, 3)
                Mat_Bij(m, 3) = Mat_Aij(k, 4)
                Mat_Bij(m, 4) = Mat_Aij(k, 5)
                Mat_Bij(m, 5) = Mat_Aij(k, 14)
                Debug.Print Mat_Bij(m, 1), Mat_Bij(m, 2), Mat_Bij(m, 3)
                m = m + 1
            End If
        
        End If
        
        If k = UBound(Mat_Aij) Then
            Mat_Bij(m, 1) = Mat_Aij(k, 1)
            Mat_Bij(m, 2) = Mat_Aij(k, 3)
            Mat_Bij(m, 3) = Mat_Aij(k, 4)
            Mat_Bij(m, 4) = Mat_Aij(k, 5)
            Mat_Bij(m, 5) = Mat_Aij(k, 14)
            Debug.Print Mat_Bij(m, 1), Mat_Bij(m, 2), Mat_Bij(m, 3), Mat_Bij(m, 4), Mat_Bij(m, 5)
        End If
        
    Next k


Dim FilePath As Variant
Dim AppWord As Word.Application
Dim DocWord As Word.Document
Dim TblWord As Word.Table
Dim MyRange As Range
Dim intX As Integer
Dim intY As Integer

'On Error GoTo ErrorHandle

FilePath = "U:\Octobre\Apporteurs_Fees.docx"

' Changer le chemin s'il n'existe pas
If Dir(FilePath) = "" Then
    
    MsgBox "File path not found. Please relocate the file"
    ' Définir une variable en tant que objet "FileDialog"
    Dim fd As FileDialog
    

    ' Créer un objet "FileDialog" de type File Picker dialog box
        Set fd = Application.FileDialog(msoFileDialogFilePicker)

    ' Définir une variable afin de contenir le chemin. Alors que le chemin est de type String,
    ' le variable doit être de type "Variant" parce que les boucles "For Each...Next"
    ' marchera seulementavec Variants and Objets.
        Dim FilePath_New As Variant
    
    ' With...End With boucle pour trouver l'objet FileDialog.
        With fd
            AllowMultiSelect = False
    ' Utiliser Show pour montrer la boîte de dialog "File Picker"
            If .Show = True Then

    ' Naviguer la collection de FileDialogSelectedItems.
                For Each FilePath_New In .SelectedItems
                FilePath = FilePath_New
                Next FilePath_New
                
            Else
            Exit Sub
            End If
        End With
    
    ' Set the object variable to Nothing.
        Set fd = Nothing
End If
    
    
Dim BrokerCount As Integer
    BrokerCount = 0
    m = 1
    
Set AppWord = New Word.Application
AppWord.Visible = True

Set DocWord = AppWord.Documents.Open(FilePath)
DocWord.Activate



  For t = 1 To DealCount
    If t + 1 <= DealCount Then
If Mat_Bij(t, 2) <> Mat_Bij(t + 1, 2) Then

DocWord.Bookmarks("Apporteur" & m).Select
DocWord.Application.Selection.InsertAfter Mat_Bij(t, 2)

DocWord.Bookmarks("Facture_Date" & m).Select
DocWord.Application.Selection.InsertDateTime DateTimeFormat:="YYYY MM DD", Insertasfield:=True

DocWord.Bookmarks("Tableau_Insertion" & m).Select
Set TblWord = AppWord.Selection.Tables.Add(AppWord.Selection.Range, (t + 1) - BrokerCount, 3)

With TblWord

.Cell(1, 1).Range.InsertAfter "Client"
.Cell(1, 2).Range.InsertAfter "Product"
.Cell(1, 3).Range.InsertAfter "Rémunération"

    With .Cell(1, 1).Shading
        .Texture = wdTextureNone
        .ForegroundPatternColor = wdColorAutomatic
        .BackgroundPatternColor = 8282112
    End With
    With .Cell(1, 1).Range
        .Font.ColorIndex = wdWhite
    End With
    With .Cell(1, 2).Shading
        .Texture = wdTextureNone
        .ForegroundPatternColor = wdColorAutomatic
        .BackgroundPatternColor = 8282112
    End With
    With .Cell(1, 2).Range
        .Font.ColorIndex = wdWhite
    End With
    With .Cell(1, 3).Shading
        .Texture = wdTextureNone
        .ForegroundPatternColor = wdColorAutomatic
        .BackgroundPatternColor = 8282112
    End With
    With .Cell(1, 3).Range
        .Font.ColorIndex = wdWhite
    End With
    
For intY = 1 To t - BrokerCount
.Cell(intY + 1, 1).Range.InsertAfter Mat_Bij(intY + BrokerCount, 3)
Next intY
For intY = 1 To t - BrokerCount
.Cell(intY + 1, 2).Range.InsertAfter Mat_Bij(intY + BrokerCount, 4)
Next intY
For intY = 1 To t - BrokerCount
.Cell(intY + 1, 3).Range.InsertAfter Round(Mat_Bij(intY + BrokerCount, 5), 2) & " EUR"
Next intY


        With .Borders(wdBorderLeft)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            End With
            With .Borders(wdBorderRight)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
        End With
        With .Borders(wdBorderTop)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
        End With
        With .Borders(wdBorderBottom)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
        End With
        With .Borders(wdBorderHorizontal)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt

        End With
        With .Borders(wdBorderVertical)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
        End With
        

End With


If t > 1 Then
BrokerCount = t
End If
m = m + 1
End If

ElseIf t = DealCount Then ' Paramètre Supérieur t = Dealcount

DocWord.Bookmarks("Apporteur" & m).Select
DocWord.Application.Selection.InsertAfter Mat_Bij(t, 2)

DocWord.Bookmarks("Facture_Date" & m).Select
DocWord.Application.Selection.InsertDateTime DateTimeFormat:="YYYY MM DD", Insertasfield:=True

DocWord.Bookmarks("Tableau_Insertion" & m).Select
Set TblWord = AppWord.Selection.Tables.Add(AppWord.Selection.Range, (t + 1) - BrokerCount, 3)

With TblWord

.Cell(1, 1).Range.InsertAfter "Client"
.Cell(1, 2).Range.InsertAfter "Product"
.Cell(1, 3).Range.InsertAfter "Rémunération"

    With .Cell(1, 1).Shading
        .Texture = wdTextureNone
        .ForegroundPatternColor = wdColorAutomatic
        .BackgroundPatternColor = 8282112
    End With
    With .Cell(1, 1).Range
        .Font.ColorIndex = wdWhite
    End With
    With .Cell(1, 2).Shading
        .Texture = wdTextureNone
        .ForegroundPatternColor = wdColorAutomatic
        .BackgroundPatternColor = 8282112
    End With
    With .Cell(1, 2).Range
        .Font.ColorIndex = wdWhite
    End With
    With .Cell(1, 3).Shading
        .Texture = wdTextureNone
        .ForegroundPatternColor = wdColorAutomatic
        .BackgroundPatternColor = 8282112
    End With
    With .Cell(1, 3).Range
        .Font.ColorIndex = wdWhite
    End With
    
For intY = 1 To t - BrokerCount
.Cell(intY + 1, 1).Range.InsertAfter Mat_Bij(intY + BrokerCount, 3)
Next intY
For intY = 1 To t - BrokerCount
.Cell(intY + 1, 2).Range.InsertAfter Mat_Bij(intY + BrokerCount, 4)
Next intY
For intY = 1 To t - BrokerCount
.Cell(intY + 1, 3).Range.InsertAfter Round(Mat_Bij(intY + BrokerCount, 5), 2) & " EUR"
Next intY


        With .Borders(wdBorderLeft)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            End With
            With .Borders(wdBorderRight)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
        End With
        With .Borders(wdBorderTop)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
        End With
        With .Borders(wdBorderBottom)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
        End With
        With .Borders(wdBorderHorizontal)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt

        End With
        With .Borders(wdBorderVertical)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
        End With
        

End With
End If

Next t

DocWord.Bookmarks("Exit_Point" & m).Select

DocWord.Application.Selection.EndKey Unit:=wdStory, Extend:=wdExtend
DocWord.Application.Selection.Delete



 Set TblWord = Nothing
 Set DocWord = Nothing
 Set AppWord = Nothing

Exit Sub

ErrorHandle:
End Sub
 
You must log in or register to reply here.

Similar threads

W
Converting IE access VBA code to work with Edge
Replies
4
Views
1,037
wackywoo105
W
S
Access VBA to Find Row and Col for found text in MS Word
Replies
3
Views
687
sxschech
S
B
Solved VBA code which exports data from Access to Excel and then loops through the Excel file
Replies
0
Views
569
BlueFllame
B
L
Export data from Access to Word with VBA
Replies
12
Views
1,039
arnelgp
arnelgp
C
Divide code to avoid "Procedure too large error"
Replies
18
Views
1,947
The_Doc_Man
The_Doc_Man

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom