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 |
Partager