Liaison entre access et excel

**lunedemiel90** · 24/06/2014, 10h53

bonjour,
Ja viens vers vous pour demander de l'aide. Etant actuellement en stage et débutante en programmation,j'ai un soucis. Je veux alimenter automatiquement les requetes access vers excel. J'ai trouvé le programme ci dessous sur une des publications, ce programme est celui qu'il me faut, mais,le problème est qu'il ne m'affiche que les tables access,or,moi je souhaiterai avoir les requêtes access,je ne sais pas quoi changer ou rajouter dans ce programme afin que ça marche. Aidez moi svp.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit 
 
Sub Tables_Access() 
Dim appAccess As Access.Application 
Dim i, j As Integer 
 
'Lance une session Access 
Set appAccess = CreateObject("Access.Application") 
 
With appAccess 
.OpenCurrentDatabase ("C:\Program Files\Microsoft Visual Studio\vb98\Biblio.mdb") 
j = 6 
For i = 1 To .CurrentData.AllTables.Count - 1 
If Left(UCase(.CurrentData.AllTables(i).Name), 4) <> "MSYS" Then 
Range("A" & j) = .CurrentData.AllTables(i).Name 
j = j + 1 
End If 
Next i 
End With 
'Quitte Access 
appAccess.Quit 
 
'Réinitialise l'objet 
Set appAccess = Nothing 
End Sub 
 
Sub Affiche_Table() 
Dim rng As Range 
Dim numLigne As Integer 
 
'Supprime les lignes pouvants contenir du texte 
Set rng = Range("C6").CurrentRegion 
rng.Delete 
 
'Affiche le contenu de la table sélectionnée 
'en lançant une requêtte sur la base Biblio 
On Error GoTo 1: 
If ActiveCell <> "" And ActiveCell.Column = 1 Then 
With ActiveSheet.QueryTables.Add(Connection:=Array("OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;" & " Data Source =C:\Program Files\Microsoft Visual Studio\vb98\Biblio.mdb"), Destination:=Range("C6")) 
.CommandType = xlCmdTable 
.CommandText = Array(ActiveCell) 
.FieldNames = True 
.RowNumbers = False 
.PreserveFormatting = True 
.BackgroundQuery = True 
.RefreshStyle = xlInsertDeleteCells 
.AdjustColumnWidth = True 
.PreserveColumnInfo = True 
.Refresh BackgroundQuery:=False 
End With 
Else 
MsgBox "Vous devez sélectionner un nom de table", vbExclamation 
End If 
On Error GoTo 0 
Exit Sub 
 
1: 
MsgBox "La table sélectionnée n'a pu être affichée", vbExclamation 
 
End Sub