[VBA-W] Remplir des champs Word avec un recordset ADO

[Mut]

Bonjour, je souhaiterais pouvoir remplir plusieurs lignes dans Word selon une listebox qui elle prend sa source dans un fichier Excel.

Voici mon code :

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
69
70
71
72
73
74
75
76
77
78
 
Private Sub ListeSociete_Change()
 
    Dim IndRst, IndRstCP As Integer
    Dim Source As ADODB.Connection
    Dim Rst, RstCP As ADODB.Recordset
    Dim ADOCommand, ADOCommandCP As ADODB.Command
    Dim Fichier As String, Cellule, CelluleCP As String, Feuille As String
 
    Selection.GoTo What:=wdGoToBookmark, Name:="Societe"
    Selection.Text = ListeSociete.Value
    Selection.MoveRight Unit:=wdCharacter, Count:=1
 
    'Adresse de la cellule contenant la donnée à récupérer
      'Pour une plage de cellules, utilisez:
      Cellule = "B4:B1705"
      CelluleCP = "I4:I1705"
 
    Feuille = "A1CLIENT$" 'n'oubliez pas d'ajouter $ au nom de la feuille.
    'Chemin complet du classeur fermé
    Fichier = "C:\CLIENT-FOURNISSEUR.xls"
 
    Set Source = New ADODB.Connection
    Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"
 
    Set ADOCommand = New ADODB.Command
    With ADOCommand
        .ActiveConnection = Source
        .CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
    End With
 
Set Rst = New ADODB.Recordset
Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
 
Set Rst = Source.Execute("[" & Feuille & Cellule & "]")
 
    IndRst = 1
     Do While Not Rst.EOF
     If Rst(0).Value <> ListeSociete.Value Then
        IndRst = IndRst + 1
     End If
        Rst.MoveNext
     Loop
     MsgBox IndRst
 
Set ADOCommand = New ADODB.Command
    With ADOCommand
        .ActiveConnection = Source
        .CommandText = "SELECT * FROM [" & Feuille & CelluleCP & "]"
    End With
 
Set Rst = New ADODB.Recordset
Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
 
Set Rst = Source.Execute("[" & Feuille & CelluleCP & "]")
 
        IndRstCP = 1
     Do While Not Rst.EOF
 
     If IndRstCP = IndRst Then
     msgbox rst(0).value
     Else
        IndRstCP = IndRstCP + 1
     End If
        Rst.MoveNext
     Loop
     MsgBox IndRstCP
 
 
Rst.Close
Source.Close
Set Rst = Nothing
Set ADOCommand = Nothing
 
Set Source = Nothing
 
end sub

le code est vraiment bricoler car je n'arrive pas à obtenir le résultat simplement. En fait la source de la listebox est comprise dans une colonne de la feuille Excel. Elle permet de remplir la première ligne

Societe
Adresse
CP Ville

ensuite j'essais de remplir les lignes suivantes en me basant sur l'indice (le numéro du recordset) du premier recordset tout en modifiant la source (c'est à dire en prenant la colonne suivante de la feuille Excel !

C'est pas facile à expliquer j'espère que c'est à peu près clair...


Mon probleme actuel est que je n'arrive pas à trouver l'indice du recordset en cours, donc je suis passé par un indice "manuel", mais maintenant c'est la valeur du recordset qui fonctionne pas ! msgbox rst(0).value me renvoit une erreur !

Si quelqu'un peut m'aider....


Merci !

[SilkyRoad]

bonjour

je te conseillerais plutot de restructurer correctement ton classeur Excel, sinon tu es parti pour créer une usine à gaz qui ne fonctionnera difficilement ...


michel

[Mut]

le problème c'est que j'ai déjà restructuré mon classeur....il contient une colonne société, une colonne adresse ainsi de suite. je souhaite donc alimenter ma liste déroulante avec la colonne société (ça c'est fait) puis une fois que l'utilisateur séléctionne dans la liste déroulante un nom de société, l'adresse la ville etc.... s'affiche automatiquement. Pour cela je dois donc récupérer l'indice du recordset de la société, me décaler d'une (ou plusieurs) colonne et de lire le contenu du recordset ! Je suis d'accord avec toi que pour l'instant ça ressemble à une usine à gaz car je suis obligé de "bidouiller" pour récupérer l'indice. A moins qu'il y ai un équivalent de la proprièté Excel "Offset" sous Word....Mais je pense pas

[SilkyRoad]

rebonjour

pour ma part je ferais une seule requête et je chargerais toutes les données dans des colonnes cachées de la ListBox, lors de la récupération des noms de société.

(Exemple dans la feuille "A1CLIENT" du classeur fermé: colonne A: NomSociete, colonne B: CodePostal, Colonne C: Ville)

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
Sub RequeteClasseurFerme()
 
    Dim i As Integer
    Dim Cn As ADODB.Connection
    Dim Fichier As String
    Dim NomFeuille As String, texte_SQL As String
    Dim Rst As ADODB.Recordset
 
    'Définit le classeur fermé servant de base de données
    Fichier = "C:\CLIENT-FOURNISSEUR.xls"
    'Nom de la feuille dans le classeur fermé
    NomFeuille = "A1CLIENT"
 
    Set Cn = New ADODB.Connection
 
    '--- Connection ---
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source=" & Fichier & _
            ";Extended Properties=Excel 8.0;"
        .Open
    End With
    '-----------------
 
    'Définit la requête.
    '/!\ Attention à ne pas oublier le symbole $ après le nom de la feuille.
    texte_SQL = "SELECT * FROM [" & NomFeuille & "$]"
 
    Set Rst = New ADODB.Recordset
    Set Rst = Cn.Execute(texte_SQL)
 
    'Supprime les données existantes dans la ListBox
    ThisDocument.ListeSociete.Clear
    'Spécifie 3 colonne dans la ListBox
    ThisDocument.ListeSociete.ColumnCount = 3
    'Indique la largeur des colonnes (les 2 dernieres sont masquées =0)
    ThisDocument.ListeSociete.ColumnWidths = "90;0;0"
 
    Do While Not Rst.EOF
        'Alim 1ere colonne ListBox
        ThisDocument.ListeSociete.AddItem Rst(0).Value
        'Alim 2eme colonne ListBox
        ThisDocument.ListeSociete. _
            List(ThisDocument.ListeSociete.ListCount - 1, 1) = Rst(1).Value
        'Alim 3eme colonne ListBox
        ThisDocument.ListeSociete. _
            List(ThisDocument.ListeSociete.ListCount - 1, 2) = Rst(2).Value
        Rst.MoveNext
    Loop
 
    '--- Fermeture connection ---
    Cn.Close
    Set Cn = Nothing
 
End Sub

il suffit ensuite de cliquer sur un élément de la ListBox pour afficher les informations correspondantes

Code :

1
2
3
4
5
6
7
8
Private Sub ListeSociete_Change()
    Dim i As Byte
 
    For i = 0 To 2
    MsgBox ThisDocument.ListeSociete. _
        List(ThisDocument.ListeSociete.ListIndex, i)
    Next i
End Sub

bon apres midi
michel

[Mut]

Merci ça à l'air parfait ! mais j'ai un probleme de "pilote ISAM introuvable"
J'ai fait des recherches sur le net et j'ai enregistré les dlls Msexcl40.dll et Msrd2x40.dll mais ça n'a rien donné...les autres solutions sont pour Access ou VB

L'erreur survient sur le code de la connexion...

[Mut]

Après avoir eu le probleme de "Pilote ISAM introuvable" et n'ayant pas pu le résoudre je suis revenu à la méthode de connexion du début. Mais une erreur persiste sur le recordset :

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
 
 
Sub RequeteClasseurFerme()
 
    Dim Source As ADODB.Connection
    Dim Rst As ADODB.Recordset
    Dim ADOCommand As ADODB.Command
    Dim Fichier As String, Cellule, CelluleCP As String, Feuille As String
 
    'Définit le classeur fermé servant de base de données
    Fichier = "C:\CLIENT-FOURNISSEUR.xls"
    'Nom de la feuille dans le classeur fermé
    Feuille = "A1CLIENT"
 
    Set Source = New ADODB.Connection
    Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"
 
    Set ADOCommand = New ADODB.Command
    With ADOCommand
        .ActiveConnection = Source
        .CommandText = "SELECT * FROM [" & Feuille & "$]"
    End With
 
Set Rst = New ADODB.Recordset
Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
 
Set Rst = Source.Execute("SELECT * FROM [" & Feuille & "$]")
 
    'Supprime les données existantes dans la ListBox
    ThisDocument.ListeSociete.Clear
    'Spécifie 3 colonne dans la ListBox
    ThisDocument.ListeSociete.ColumnCount = 3
    'Indique la largeur des colonnes (les 2 dernieres sont masquées =0)
    ThisDocument.ListeSociete.ColumnWidths = "90;0;0"
 
    Do While Not Rst.EOF
        'Alim 1ere colonne ListBox
        ThisDocument.ListeSociete.AddItem Rst(0).Value
        'Alim 2eme colonne ListBox
        ThisDocument.ListeSociete. _
            List(ThisDocument.ListeSociete.ListCount - 1, 1) = Rst(1).Value
        'Alim 3eme colonne ListBox
        ThisDocument.ListeSociete. _
            List(ThisDocument.ListeSociete.ListCount - 1, 2) = Rst(2).Value
        Rst.MoveNext
    Loop
 
 Rst.Close
Source.Close
Set Rst = Nothing
Set ADOCommand = Nothing
 
Set Source = Nothing

l'erreur survient sur le "ThisDocument.ListeSociete.AddItem Rst(0).Value" et l'erreur est "le type ne correspond pas

[BrunoM45]

Je ne comprends pas d'ou vient ton erreur, à part un problème dans les propriétés de ta ListeBox !

Chez moi ça fonctionne parfaitement, ci-joint les fichiers que j'ai utilisés

Cordialement.

[Mut]

Effectivement...apparemment cela vient de mon fichier Excel vu que les données commencent à la ligne 4...

[BrunoM45]

Dans ce cas tu peux éventuellement tester tes enregistrements

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
Do While Not Rst.EOF
  If Len(Rst(0).value)<>0 then
        'Alim 1ere colonne ListBox
        ThisDocument.ListeSociete.AddItem Rst(0).Value
        'Alim 2eme colonne ListBox
        ThisDocument.ListeSociete. _
            List(ThisDocument.ListeSociete.ListCount - 1, 1) = Rst(1).Value
        'Alim 3eme colonne ListBox
        ThisDocument.ListeSociete. _
            List(ThisDocument.ListeSociete.ListCount - 1, 2) = Rst(2).Value
  End If
        Rst.MoveNext
    Loop

Ou alors dans ton select

Un truc du style :

Code :

Set Rst = Source.Execute("SELECT * FROM [" & Feuille & "$] WHERE [ChampClient] Is Not Null")

Voilà

[Mut]

Merci beaucoup ! ça à l'air de mieux fonctionner déjà... par contre quand tu mets "[champsClient]", tu parles de l'entete sur la feuille Excel ?

[BrunoM45]

Envoyé par Mut

Merci beaucoup ! ça à l'air de mieux fonctionner déjà... par contre quand tu mets "[champsClient]", tu parles de l'entete sur la feuille Excel ?

Oui, tout à fait !
L'entête de la colonne qui devient le nom du champ dans la requête.

Cordialement.

[Mut]

Ok parfait et une dernière chose...si mon entete est à x lignes ?Ou je peux le spécifier ?

[BrunoM45]

No soucy

Car la commande :

Code :

Set Rst = Source.Execute("SELECT * FROM [" & Feuille & "$]")

Va chercher dans ta feuille les premières lignes contenant des valeurs

Si en revanche au dessus de l'entête tu as des lignes qui contiennent
du texte, qui n'a rien à voir avec le reste. Là, il faut spécifier la plage !

[Mut]

Ok je me suis arrangé pour que ça tombe bien ! il me reste un dernier soucis auquel j'arrive pas à trouver de solution... voici un exemple :

Societe1 adresse1
Societe2
Societe3 adresse3
Societe4 adresse4

Si je suis dans ce cas de figure, la société 2 n'est pas dans la liste alors que je souhaiterais quand meme qu'elle apparaisse meme si certains champs sont incomplets...