[VB6] [Excel] Résultat d'une requete ds une feuille

**elifqaoui** · 18/08/2002, 19h39

bonjour,
je veux mettre dans mon program un commande qui permet de prendre le résultat d'une requete et le charger dans une feuille excel.
comment devrais-je faire sachant que je n'ai jamais travaillé en excel depuis VB

**DarkVader** · 18/08/2002, 20h11

utilises la méthode querytable.add avec l'objet range
elle permet de créer directement la requête dans Excel.

**elifqaoui** · 18/08/2002, 20h39

merci DarkVader mais je te demanderai un peu plus d'explication stp

**DarkVader** · 18/08/2002, 22h03

Voila une fonction, que j'utilise sous VBA
et qu'il te suffira d'adapter pour VB
en créant une instance à Excel

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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
Dim appXcel as New Excel.Application, etc...)
 
Function Actualize_QueryTable(Dest As Range, strConn As String, strSQL As String, Refresh_Opt As Boolean, Optional Options As Variant)
    Dim TypeConnect As String, IsQT As Boolean
    IsQT = QueryTableExists(Dest)
 
 
    If IsQT Then
        With Dest.QueryTable
            .Connection = strConn
            TypeConnect = Left(.Connection, InStr(1, .Connection, ";") - 1)
            If TypeConnect = "ODBC" Then .CommandText = strSQL
            If Not IsMissing(Options) Then
                If Options(1) = "" Then .FieldNames = Options(1)            'FieldNames
                If Options(2) = "" Then .RowNumbers = Options(2)            'RowNumbers
                If Options(3) = "" Then .FillAdjacentFormulas = Options(3)  'FillAdjacentFormulas
                If Options(4) = "" Then .PreservingFormatting = Options(4)  'PreservingFormatting
                If Options(5) = "" Then .RefreshOnFileOpen = Options(5)     'RefreshOnFileOpen
                If Options(6) = "" Then .BackgroundQuery = Options(6)       'BackGroundQuery
                If Options(7) = "" Then .RefreshStyle = Options(7)          'RefreshStyle
                If Options(8) = "" Then .SavePasswort = Options(8)          'SavePasswort
                If Options(9) = "" Then .SaveData = Options(9)              'SaveData
                If Options(10) = "" Then .AdjustColumnsWidth = Options(10)  'AdjustColumnsWidth
                If Options(11) = "" Then .RefreshPeriod = Options(11)       'RefreshPeriod
                If Options(12) = "" Then .PreserveColumnInfo = Options(12)  'PreserveColumnInfo
            End If
            If Refresh_Opt Then .Refresh BackgroundQuery:=False
        End With
    Else
        If IsMissing(Options) Then
            ReDim Options(1 To 12)
            Options(1) = True                   'FieldNames
            Options(2) = False                  'RowNumbers
            Options(3) = False                  'FillAdjacentFormulas
            Options(4) = True                   'PreservingFormatting
            Options(5) = False                  'RefreshOnFileOpen
            Options(6) = False                  'BackGroundQuery
            Options(7) = xlInsertDeleteCells    'RefreshStyle (xlInsertDeleteCells/xlOverwriteCells/xlInsertEntireRows)
            Options(8) = True                   'SavePasswort
            Options(9) = True                   'SaveData
            Options(10) = True                  'AdjustColumnsWidth
            Options(11) = 0                     'RefreshPeriod
            Options(12) = True                  'PreserveColumnInfo
        Else
            If Options(1) = "" Then Options(1) = True                   'FieldNames
            If Options(2) = "" Then Options(2) = False                  'RowNumbers
            If Options(3) = "" Then Options(3) = False                  'FillAdjacentFormulas
            If Options(4) = "" Then Options(4) = True                   'PreservingFormatting
            If Options(5) = "" Then Options(5) = False                  'RefreshOnFileOpen
            If Options(6) = "" Then Options(6) = False                  'BackGroundQuery
            If Options(7) = "" Then Options(7) = xlInsertDeleteCells    'RefreshStyle
            If Options(8) = "" Then Options(8) = True                   'SavePasswort
            If Options(9) = "" Then Options(9) = True                   'SaveData
            If Options(10) = "" Then Options(10) = True                 'AdjustColumnsWidth
            If Options(11) = "" Then Options(11) = 0                    'RefreshPeriod
            If Options(12) = "" Then Options(12) = True                 'PreserveColumnInfo
        End If
 
        'Supprimer les données de la plage
        Dest.CurrentRegion.ClearContents
        'Créer la requête
 
        With Worksheets(Dest.Parent.Name).QueryTables.Add(Connection:=strConn, Destination:=Dest)
            TypeConnect = Left(.Connection, InStr(1, .Connection, ";") - 1)
            If TypeConnect = "ODBC" Then .CommandText = strSQL
            .FieldNames = Options(1)
            .RowNumbers = Options(2)
            .FillAdjacentFormulas = Options(3)
            .PreserveFormatting = Options(4)
            .RefreshOnFileOpen = Options(5)
            .BackgroundQuery = Options(6)
            .RefreshStyle = Options(7)
            .SavePassword = Options(8)
            .SaveData = Options(9)
            .AdjustColumnWidth = Options(10)
            .RefreshPeriod = Options(11)
            .PreserveColumnInfo = Options(12)
            If Refresh_Opt Then .Refresh Options(6)
        End With
    End If
End Function

Il est possible de faire retourner le résultat de la requête
par le biais de la fonction en retournant le résultat de la méthode refresh
(True=Requête réussie/false: a échouée)

**elifqaoui** · 18/08/2002, 22h07

ok merci pr l'information je vais essayer de voir ca meme si à première vue je pige pas bcp

**elifqaoui** · 19/08/2002, 18h05

merci DarkVader, mais à vrai dire j'ai pas bp appris de ta fct (jusqu'à l'instant), alors j'aimerais que tu me dis les étapes que tu as suivi dans ta fonction (ca me parait encore un peu brouillé

) et merci

**DarkVader** · 19/08/2002, 18h21

Ça me semble assez clair pourtant :

Dest est une référence de cellule
strConn est une chaine décrivant la connection
ex: "ODBC;DSN=MS Access Database;DBQ=C:\MaBase.mbd & ";DefaultDir=" & PathNameOnly("C:\MaBase.mbd ")& ";DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;"
strSQL est une chaine décrivant la requête au format SQL
ex: "SELECT Rq_SJ.Libellé, Rq_SJ.`CODE Comstock`, Rq_SJ.`CODE Euronext` FROM `" & Left("C:\MaBase.mbd ", Len("C:\MaBase.mbd ")- 4) & "`.Rq_SJ Rq_SJ ORDER BY Rq_SJ.Libellé"

Il manque au code précédent, les fonctions suivantes :

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
Function QueryTableExists(CellDestination As Range)
    ' Vérifie la présence d'une requête de donnée
    Dim obj As Object
    On Error GoTo traiterreur
    QueryTableExists = False
    Set obj = CellDestination.QueryTable.ResultRange
    QueryTableExists = True
    Exit Function
traiterreur:
    QueryTableExists = False
    Resume suite
suite:
End Function
 
Public Function PathNameOnly(FName) As String
' Ne retourner que le chemin du dossier
    Dim i As Integer, lenght As Integer
    lenght = Len(FName)
    For i = lenght To 1 Step -1
        If Mid(FName, i, 1) = Application.PathSeparator Then
            PathNameOnly = Left(FName, i - 1)
            Exit Function
        End If
    Next i
End Function

qui indiquent
1) si une requête existe
2) le chemin d'un fichier

La fonction crée une requête d'importation dans la feuille si elle n'existe pas, sinon elle la modifie puis l'actualise

A toi d'adapter le tout pour l'exécuter sous VB en créant une instance
avec
dim AppXcel as New excel.application
appxcel.workbooks.open ...
etc

**elifqaoui** · 20/08/2002, 18h22

bonjour DarkVader, voilà j'essaye de faire mes débuts dans excel depuis Vb, j'essaye d'ouvrir un fichier excel existant puis la feuille active, mais le pb qui se pose c que le fichier devient après en lecture seule et je peux pas l'ouvrir après depuis indépendamment pour faire des modifications, que dois-je faire à ton avis, voilà mon code :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Dim appExcel As Excel.Application 'Application Excel
Dim wbExcel As Excel.Workbook 'Classeur Excel
Dim wsExcel As Excel.Worksheet 'Feuille Excel
 
'Ouverture de l'application
Set appExcel = CreateObject("Excel.Application")
Set wbExcel = appExcel.Workbooks.Open("d:\teste.xls")
'Récupération de la feuille par défaut
Set wsExcel = wbExcel.ActiveSheet
wbExcel.Close
Set wbExcel = Nothing
End Sub

**DarkVader** · 20/08/2002, 18h31

Essaie

Code :

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

1
2
3
4
5
6
7
Dim appExcel As New Excel.Application 'Application Excel 
Dim wbExcel As Excel.Workbook 'Classeur Excel 
Dim wsExcel As Excel.Worksheet 'Feuille Excel 
 
'Ouverture de l'application 
Set wbExcel = appExcel.Workbooks.Open(FileName:="d:\teste.xls",ReadOnly:=False) 
...

Evidemment ensuite tu penses à tout refermer
et notamment à mettre appExcel ... à nothing

**elifqaoui** · 20/08/2002, 18h37

non ca marche pas il reste tj en lecture seule et je peux pas y accéder en dehors du Vb, mais moi je veux le contraire, comment changer la lecture seule en écriture (pr pouvoir l'utiliser librement)

**DarkVader** · 20/08/2002, 18h53

C'est surprenant car j'utilise cette méthode
pour ouvrir des classeurs tiers avant d'intervenir dessus
et pourtant, no problems !!!

**elifqaoui** · 20/08/2002, 19h33

voilà j'ai réussi à mettre au point un petit code et ca marche bien sauf que le champ(0) est une date et lui il le positionne convertit en nombre, moi je le veux toujours comme date que pensez-vous??

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
 
Private Sub cmdBDAEXCEL_Click()
  Dim DBA As Database
  Dim Enreg As String
  Dim Tabe As Recordset
  Dim Appli As New Application
  Dim Ligne As Long
 
 
  Text1.Text = #8/1/2002#
  Set DBA = OpenDatabase("D:\DESS-PINDURE\Elifqaoui\bases de donnees\project\applic\gestelec.mdb")
 
 
   Enreg = " SELECT * FROM compteur WHERE (((section.Date)= #" & Format(Text1, "mm/dd/yy") & "#));"
       Set Tabe = DBA.OpenRecordset(Enreg, dbOpenSnapshot)
 
  Ligne = 1
  Appli.Visible = True
 
  Appli.Workbooks.Add
 
  With Appli.ActiveWorkbook.Worksheets("feuil1")
 
Tabe.MoveFirst
 
  Do While Tabe.EOF = False
 
    .Cells(Ligne, 1) = Tabe.Fields(0)
 
    .Cells(Ligne, 2) = Tabe.Fields(1)
 
    .Cells(Ligne, 3) = Tabe.Fields(6)
 
    Ligne = Ligne + 1
 
    Tabe.MoveNext
 
    Loop
 
  End With
 
End Sub

**Patf** · 07/01/2003, 17h52

Hello! et Bonne année!

J'ai essayé d'adapter ton code final, mais j'ai des problèmes:

1- tout d'abord, le fichier s'ouvre en lecture seule, pas moyen d'y faire quoi que ce soit...
Et si j'enlève les commentaires à ''appExcel.Workbooks.Add", j'obtiens une version modifiable certes, mais d'un nouveau fichier; or je dois enregistrer dans le même fichier.

2- ensuite, pourrais tu me faire part de ta macro pour obtenir une date pour le premier champ, s'il te plaît?

3- enfin, est-il possible de faire apparaître les noms des attibuts de la table en 1ère ligne, plutôt que d'avoir à tous les réécrire?

Merci beaucoup!

Voici mon code:

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
Private Sub Commande108_Click()
On Error GoTo Err_Commande108_Click
 
Dim appExcel As Excel.Application
Dim wbExcel As Excel.Workbook
 
Set appExcel = CreateObject("Excel.Application")
appExcel.Visible = True
On Error Resume Next
appExcel.UserControl = True
Set wbExcel = appExcel.Workbooks.Open(FileName:="d:\test.xls", ReadOnly:=False)
 
  Dim DBA As Database
  Dim Enreg As String
  Dim Tabe As Recordset
  Dim Ligne As Long
  Dim Col As Long
 
  Set DBA = OpenDatabase("C:\Gammetal\Gam_dat.mdb")
 
  Enreg = " SELECT * FROM CAPTEUR; "
       Set Tabe = DBA.OpenRecordset(Enreg, dbOpenSnapshot)
 
Ligne = 1
 
'appExcel.Workbooks.Add
 
  With appExcel.ActiveWorkbook.Worksheets("feuil1")
 
Tabe.MoveFirst
 
  Do While Tabe.EOF = False
    For Col = 1 To 46
    .Cells(Ligne, Col) = Tabe.Fields(Col - 1)
    Next
 
    Ligne = Ligne + 1
 
    Tabe.MoveNext
 
    Loop
 
  End With
 
Exit_Commande108_Click:
    Exit Sub
 
Err_Commande108_Click:
    MsgBox Err.Description
    Resume Exit_Commande108_Click
 
End Sub

[VB6] [Excel] Résultat d'une requete ds une feuille

VB 6 et antérieur

Discussions similaires

Partager

Partager