Envoyer champs de table a Word

[chinarro]

Bonjour,

je cherche un exemple de code VBA pour envoyer la valeur d'un champ d'une table a un signet de Word.

Dans mon cas concret, le document word.dotx contien plus de 50 signets qui doivent recuperer les valeur de plusieurs tables de la BD.

Merci d'avance.

[argyronet]

Bonjour,

Non seulement de nombreux exemples existent dans ce forum et sur le Web en général mais tu aurais pu tenter au moins de procéder avec une macro à enregistrement depuis Word lui-même pour connaître la syntaxe de l'objet Bookmark.
Ensuite, tu créés un objet Word ou tu pilotes à travers la lecture des enregistrements de ta requêtes (via DAO), les signets à alimenter.

Toutefois, peut-être que tu n'es pas en mesure d'écrire une telle procédure, auquel cas, fais-nous le savoir.

Argy

[chinarro]

j'ai regardé sur le forum, mais je n'ai pas trouvé comment exporter les données de plusieurs tables a un document word.

Pour les macros depuis word, c'est helas un peu compliqué pour moi,

merci

[chinarro]

voici le code que j'ai, mais qui ne marche pas...

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Private Sub Comando164_Click()
 
' This method creates a new document in
' MS Word using Automation
  Dim rsCust As New ADODB.Recordset
  Dim sSQL As String
  Dim WordObj As Word.Application
  Dim iTemp As Integer
 
On Error Resume Next
 
'sSQL = "SELECT Devis.Id, Devis.[Devis nº], D1.surf, saisieprincipale.[Salon:], saisieprincipale.[Séjour :], saisieprincipale.[Salle à manger :], saisieprincipale.[Coin Repas :], saisieprincipale.[Cuisine :], saisieprincipale.[Cellier :], saisieprincipale.[Buanderie :], saisieprincipale.[Chambre 1 :], saisieprincipale.[Chambre 2 :], saisieprincipale.[Chambre 3 :], saisieprincipale.[Chambre 4 :], saisieprincipale.[Chambre 5 :], saisieprincipale.[Salle de Bains 1 :], saisieprincipale.[salle de Bains 2 :], saisieprincipale.[Salle de Bains 3 :], saisieprincipale.[WC 1 :], saisieprincipale.[WC 2 :], saisieprincipale.[WC 3 :], saisieprincipale.[Autre :], saisieprincipale.[local Technique :], saisieprincipale.[Garage :], saisieprincipale.[Réserve :], saisieprincipale.[Atelier :], saisieprincipale.[Bureau :]"
'FROM (Devis INNER JOIN D1 ON Devis.Id = D1.Id) INNER JOIN saisieprincipale ON (Devis.Id = saisieprincipale.Id) AND (D1.Id = saisieprincipale.Id)"
 
 
 
  rsCust.Open sSQL, CurrentProject.Connection
 
                If rsCust.EOF Then
                  MsgBox "Client Inconu", vbOKOnly
                  Exit Sub
                End If
 
  DoCmd.Hourglass True
 
  'Try to get a running instance of Word:
  Set WordObj = GetObject(, "Word.Application")
  If Err.Number <> 0 Then
    'An error is thrown if Word is not running,
    'so use CreateObject to start up Word:
    Set WordObj = CreateObject("Word.Application")
  End If
 
  'Make sure the user can see Word:
  WordObj.Visible = True
 
  'Warning:
  'Specify the correct drive and path to the
  'file named Thanks.dotx in the line below.
 
  WordObj.Documents.Add _
  Template:="C:\Devis\Devis.dotx", NewTemplate:=False
 
 
  With WordObj.Selection
 
 
 
    '.GoTo what:=wdGoToBookmark, Name:="DEVIS"
    '.TypeText rsCust! [Texto54]
 
    'iTemp = InStr(rsCust![Texto54], " ")
 
    'If iTemp > 0 Then
      '.TypeText Left$(rsCust![Texto54], iTemp - 1)
    'End If
 
 
    DoEvents
    WordObj.Activate
    .MoveUp wdLine, 6
  End With
 
  'Set the Word Object to Nothing to free resources:
  Set WordObj = Nothing
  DoCmd.Hourglass False
 
End Sub

merci de m'indiquer les erreurs, en sachant que ce code es copié d'un exemple qui exporte d'un formulaire et non d'une table.

[argyronet]

Humm, pas tip top ce code...
Sur la toile il y a bien mieux, bref voici un exemple que je viens de t'écrire (il est bien entendu à adapter) :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Private Sub RemplirSignets()
Const MON_DOC                                          As String = "D:\Documents and Settings\Argyronet\Mes documents\Trash\VBA\Word\TestSignetsDAO.doc"
Dim oAppWord                                           As Word.Application
Dim oWordDoc                                           As Word.Document
Dim oSignet                                            As Word.Bookmark
Dim strNomSignet                                       As String
Dim strValeurSignet                                    As String
 
Dim SQL                                                As String
Dim oRS                                                As DAO.Recordset
Dim F                                                  As Integer
 
    'Instancie Word (ne pas faire un GetObject())
    Set oAppWord = New Word.Application
    With oAppWord
        .Visible = False
        'On ouvre le document
        Set oWordDoc = .Documents.Open(MON_DOC)
        'On ouvre une requête
        SQL = "SELECT * FROM MaTableTest WHERE CodeClient = 3"
        Set oRS = CurrentDb.OpenRecordset(SQL, dbOpenForwardOnly)
        'On parcours tous les champs qui sont aussi le nom des signets du document
        With oRS
            For F = 0 To .Fields.Count - 1
                'On affecte le nom du signet et sa valeur
                strNomSignet = .Fields(F).Name
                strValeurSignet = .Fields(F).Value
                'On pose la valeur pour le signet cible
                With oAppWord.Selection
                    .Goto What:=wdGoToBookmark, Name:=strNomSignet
                    .TypeText Text:=strValeurSignet
                End With
            Next
            'On ferme le recordset
            .Close
        End With
        'On ferme le document
        With oWordDoc
            .Save
            .Close
        End With
        'On quitte l'instance
        .Quit
    End With
    'On libère la mémoire
    Set oAppWord = Nothing
    Set oRS = Nothing
End Sub

Argy