Discussion :

[docjo]

Bonjour

Afin d'avoir une lecture plus simple de la structure d'une de mes requêtes (pour la reproduire dans un autre logiciel), je souhaiterai l'exporter vers excel.
La fonction suivante récupère un certain nombre de renseignements mais pas la structure des champs "As"

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
 
Public Function ExportQueryFields(QryName As String)
 
 
    Dim lFld As Long
    Dim dBase As Database
    Dim xlApp As Object
    Dim wbExcel As Object
    Dim lRow As Long
    Dim qdf As DAO.QueryDef
    Dim fld As DAO.Field
 
     'Détermine la base actuelle et crée une nouvelle instance excel
    Set dBase = CurrentDb
    Set xlApp = CreateObject("Excel.Application")
    Set wbExcel = xlApp.workbooks.Add
    Set qdf = dBase.QueryDefs(QryName)
 
     'Gestion des erreurs
    On Error Resume Next
 
    'Ajout de colonnes
    lRow = 1
    With wbExcel.sheets(1)
        .Range("A" & lRow) = "Nom Requete"
        .Range("B" & lRow) = "Nom Champ"
        .Range("C" & lRow) = "Type"
        .Range("D" & lRow) = "Taille"
        .Range("E" & lRow) = "Code SQL"
        '.Range("F" & lRow) = "Expression"
    End With
 
     'Selection de la requete
     With qdf
             'Ecriture de chaque champ
            For lFld = 0 To tdf.Fields.Count - 1
                lRow = lRow + 1
                With wbExcel.sheets(1)
                    .Range("A" & lRow) = qdf.Name
                    .Range("B" & lRow) = qdf.Fields(lFld).Name
                    .Range("C" & lRow) = qdf.Fields(lFld).Type
                    .Range("D" & lRow) = qdf.Fields(lFld).Size
                    'Ici le champ où il faut trouver le code SQL des "As"
                    .Range("E" & lRow) = qdf.Fields(lFld).SourceField
 
                End With
            Next lFld
 
    End With
 
    On Error GoTo 0
 
    xlApp.Visible = True
    Set xlApp = Nothing
    Set wbExcel = Nothing
    Set dBase = Nothing
 
End Function

Exemple d'un champ "As"

Code :

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

1
2
 
 IIf([age]<60,0,IIf([age] Between 60 And 64,1,IIf([age] Between 65 And 69,2,IIf([age] Between 70 And 74,3,IIf([age] Between 75 And 79,4,IIf([age] Between 80 And 84,5,IIf([age] Between 85 And 90,6))))))) AS Valage

Dans la colonne "Nom Champ" je trouve "Valage", et en ""Code SQL" (colonne E) j'aimerai avoir "IIf([age]<60,0,IIf([age] Between 60 And 64,1,IIf([age] Between 65 And 69,2,IIf([age] Between 70 And 74,3,IIf([age] Between 75 And 79,4,IIf([age] Between 80 And 84,5,IIf([age] Between 85 And 90,6)))))))"

Avez-vous une idée sur la façon de procéder ?
Merci par avance pour vos suggestions.

[VinceVBA]

Je suis pas un expert mais je ne pense pas que ce soit possible à part en le faisant à la main dans ton code VBA à partir de la requête SQL brute.

[docjo]

Je le sens un peu comme ça. J'attends que les experts me donnent leur avis. Je sais que l'on peut exporter le code sql et j'imagine le découper pour le "ranger" dans les champs.

[marsouin_89]

Bonjour,

Un exemple de nos amis du grenier à sel.
A toi de l'adapter à tes besoins.

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
Sub SauvegarderRequetes( _
     ByVal strChemin As String, _
     Optional ByVal blnCommentaires As Boolean = True)
 
    ' Quelques variables
     Dim db As DAO.Database
     Dim qdf As DAO.QueryDef
     Dim intFichier As Integer
 
    ' Ouvrir le fichier
     On Error GoTo SauvegarderErr
     intFichier = FreeFile
     Open strChemin For Output As #intFichier
 
    ' Parcourir toutes les requêtes
     ' et les écrire dans le fichier
     Set db = CurrentDb
     For Each qdf In db.QueryDefs
         If Left(qdf.Name, 1) <> "~" Then
             ' Commentaire
             If blnCommentaires Then
                 Print #intFichier, "-- Requête : " & qdf.Name
             End If
 
            ' Code de la requête
             Print #intFichier, qdf.SQL
         End If
     Next
 
    ' On ferme !
     Close #intFichier
     Set db = Nothing
     MsgBox "Opération terminée !", vbInformation
     Exit Sub
 
SauvegarderErr:
     MsgBox "Erreur : " & Err.Description, vbExclamation
     Exit Sub
 End Sub

Cordialement

Christophe

[docjo]

Merci Christophe mais il faut que j'exporte chaque champ dans une ligne, et dans un fichier excel. J'avais déjà adapté ce code mais il écrit dans un fichier texte.
J'avais trouve le code qui suit qui exporte en csv mais seulement les tables

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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
 
Public Sub GetQrysAndTbls()
' Using a few items found on the internet write query and table definitions
' to a text file including field detail for tables
 
 
' Original posts found at:
' http://www.techrepublic.com/article/how-to-create-a-list-of-tables-or-queries-from-access/5047664
' http://forums.techguy.org/business-applications/526520-solved-getting-field-names-tables.html
' http://www.everythingaccess.com/tutorials.asp?ID=Dump-table-details-in-VBA-(DAO)
' http://www.access-programmers.co.uk/forums/showthread.php?t=28219
    Dim db As Database
    Dim Qry As QueryDef
    Dim QryCount As Integer
    Dim Tbl As TableDef
    Dim TblCount As Integer
    Dim fso, TxtFile
 
    ' initialize variables
    Set db = CurrentDb
    QryCount = 0
    TblCount = 0
 
    ' First the Querys, use txt file since "," 's mess up in CSV
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set TxtFile = fso.CreateTextFile("c:\tmp\QryDefs.txt", True)
    TxtFile.writeline ("Query name" & vbTab & "SQL String")
    For Each Qry In db.QueryDefs
      ' erase any  CrLf, could also add a "," instead also make sure that the query is a string
      TxtFile.writeline (Qry.Name & vbTab & Replace(Qry.SQL, vbCrLf, ""))
      QryCount = QryCount + 1
    Next
    TxtFile.Close
 
    ' Now the Tables and Field definitions
    Set TxtFile = fso.CreateTextFile("c:\tmp\TableDefs.csv", True)
    ' Put the header line in place
    TxtFile.writeline ("Table Name:,Fields: Field Name,Field Type,Size,Required,Default,Description")
    For Each Tbl In db.TableDefs
      If Tbl.Attributes = 0 Then 'Ignores System Tables
        ' place the table name in the first line,
        TxtFile.write (Tbl.Name)
        ' write the fields leaving space at the front of each for formatting purposes
        For Each fld In Tbl.Fields
          TxtFile.writeline ("," & fld.Name & "," & FieldTypeName(fld) & "," & fld.Size & "," & _
              IIf(CBool(fld.Required), "True", "False") & "," & CStr(fld.DefaultValue) & "," & GetDescrip(fld))
        Next
        TblCount = TblCount + 1
      End If
    Next
    TxtFile.Close
 
    ' Now the Tables and Index definitions
    Set TxtFile = fso.CreateTextFile("c:\tmp\TableIndexs.csv", True)
    ' Put the header line in place
    TxtFile.writeline ("Table Name:,Indexes: Name,Primary,Unique,NoNulls,Fields")
    For Each Tbl In db.TableDefs
      If Tbl.Attributes = 0 Then 'Ignores System Tables
        ' place the table name in the first line,
        TxtFile.write (Tbl.Name)
        ' write the fields leaving space at the front of each for formatting purposes
        For Each idx In Tbl.Indexes
          TxtFile.write ("," & idx.Name & "," & idx.Primary & "," & idx.Unique & "," & idx.IgnoreNulls)
          ' Now write the fields
          For Each fld In idx.Fields
            TxtFile.write ("," & fld.Name)
          Next
          TxtFile.writeline ("")
        Next
      End If
    Next
    TxtFile.Close
 
    MsgBox "Wrote: " & Str$(QryCount) & " Queries, and " & Str$(TblCount) & " table definiations to file."
 
    ' close the files and db
    db.Close
    Set db = Nothing
End Sub
 
 
Function GetDescrip(ByVal obj As Object) As String
    On Error Resume Next
    GetDescrip = obj.Properties("Description")
End Function
 
 
 
 
Function FieldTypeName(ByVal fld As DAO.Field) As String
    'Purpose: Converts the numeric results of DAO Field.Type to text.
    Dim strReturn As String    'Name to return
 
 
    Select Case CLng(fld.Type) 'fld.Type is Integer, but constants are Long.
        Case dbBoolean: strReturn = "Yes/No"            ' 1
        Case dbByte: strReturn = "Byte"                 ' 2
        Case dbInteger: strReturn = "Integer"           ' 3
        Case dbLong                                     ' 4
            If (fld.Attributes And dbAutoIncrField) = 0& Then
                strReturn = "Long Integer"
            Else
                strReturn = "AutoNumber"
            End If
        Case dbCurrency: strReturn = "Currency"         ' 5
        Case dbSingle: strReturn = "Single"             ' 6
        Case dbDouble: strReturn = "Double"             ' 7
        Case dbDate: strReturn = "Date/Time"            ' 8
        Case dbBinary: strReturn = "Binary"             ' 9 (no interface)
        Case dbText                                     '10
            If (fld.Attributes And dbFixedField) = 0& Then
                strReturn = "Text"
            Else
                strReturn = "Text (fixed width)"        '(no interface)
            End If
        Case dbLongBinary: strReturn = "OLE Object"     '11
        Case dbMemo                                     '12
            If (fld.Attributes And dbHyperlinkField) = 0& Then
                strReturn = "Memo"
            Else
                strReturn = "Hyperlink"
            End If
        Case dbGUID: strReturn = "GUID"                 '15
 
 
        'Attached tables only: cannot create these in JET.
        Case dbBigInt: strReturn = "Big Integer"        '16
        Case dbVarBinary: strReturn = "VarBinary"       '17
        Case dbChar: strReturn = "Char"                 '18
        Case dbNumeric: strReturn = "Numeric"           '19
        Case dbDecimal: strReturn = "Decimal"           '20
        Case dbFloat: strReturn = "Float"               '21
        Case dbTime: strReturn = "Time"                 '22
        Case dbTimeStamp: strReturn = "Time Stamp"      '23
 
 
        'Constants for complex types don't work prior to Access 2007.
        Case 101&: strReturn = "Attachment"         'dbAttachment
        Case 102&: strReturn = "Complex Byte"       'dbComplexByte
        Case 103&: strReturn = "Complex Integer"    'dbComplexInteger
        Case 104&: strReturn = "Complex Long"       'dbComplexLong
        Case 105&: strReturn = "Complex Single"     'dbComplexSingle
        Case 106&: strReturn = "Complex Double"     'dbComplexDouble
        Case 107&: strReturn = "Complex GUID"       'dbComplexGUID
        Case 108&: strReturn = "Complex Decimal"    'dbComplexDecimal
        Case 109&: strReturn = "Complex Text"       'dbComplexText
        Case Else: strReturn = "Field type " & fld.Type & " unknown"
    End Select
 
 
    FieldTypeName = strReturn
End Function

[marsouin_89]

Bonjour,

A mon avis, tu n'as pas d'autres choix que de faire une fonction qui analysera les valeurs SQL pour ensuite en faire une extraction et l'exporter dans ton fichier Excel ou inscrire ces valeurs dans une table temporaire qui elle sera exportée vers Excel.
Cela doit être possible avec Split et les valeurs par défauts de SQL (SELECT, FROM, ect.).

A creuser

Cordialement

Christophe

[docjo]

Le code suivant est la version excel du "#print" et récupère en F2 le code SQL

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
 
Public Function ExportQueryFields(QryName As String)
 
 
    Dim lFld As Long
    Dim dBase As Database
    Dim xlApp As Object
    Dim wbExcel As Object
    Dim lRow As Long
    Dim qdf As DAO.QueryDef
    Dim fld As DAO.Field
 
     'Détermine la base actuelle et crée une nouvelle instance excel
    Set dBase = CurrentDb
    Set xlApp = CreateObject("Excel.Application")
    Set wbExcel = xlApp.workbooks.Add
    Set qdf = dBase.QueryDefs(QryName)
 
     'Gestion des erreurs
    On Error Resume Next
 
    'Ajout de colonnes
    lRow = 1
    With wbExcel.sheets(1)
        .Range("A" & lRow) = "Nom Requete"
        .Range("B" & lRow) = "Nom Champ"
        .Range("C" & lRow) = "Type"
        .Range("D" & lRow) = "Taille"
        .Range("E" & lRow) = "Code SQL"
        '.Range("F" & lRow) = "Expression"
        .Range("F1") = "SQL"
    End With
 
     'Selection de la requete
     With qdf
             'Ecriture de chaque champ
            For lFld = 0 To tdf.Fields.Count - 1
                lRow = lRow + 1
                With wbExcel.sheets(1)
                    .Range("A" & lRow) = qdf.Name
                    .Range("B" & lRow) = qdf.Fields(lFld).Name
                    .Range("C" & lRow) = qdf.Fields(lFld).Type
                    .Range("D" & lRow) = qdf.Fields(lFld).Size
                    'Ici le champ où il faut trouver le code SQL des "As"
                    .Range("E" & lRow) = qdf.Fields(lFld).SourceField
                    .Range("F2") = qdf.sql
                End With
            Next lFld
 
 
    End With
 
    On Error GoTo 0
 
    xlApp.Visible = True
    Set xlApp = Nothing
    Set wbExcel = Nothing
    Set dBase = Nothing
 
End Function

MAis ce n'est pas ce que je veux: le code SQL de chaque champ "AS" dans une cellule.
Comme je disais je sentais bien qu'il faudrait bricoler, mais au cas où ...

Juste pour vous montrer ce fameux 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
53
54
55
56
57
58
59
60
61
62
63
64
65
 
SELECT T_Patient.ID_Patient, T_sejour.ID_sejour, T_Intervention.ID_Intervention, T_Patient.Datenaissance, T_Patient.Sexe, T_Patient.Poids, T_Patient.Taille, T_Intervention.Date_intervention, Year([T_intervention]![Date_intervention])-Year([T_Patient]![Datenaissance]) AS age, 
IIf([age]<60,0,IIf([age] Between 60 And 64,1,IIf([age] Between 65 And 69,2,IIf([age] Between 70 And 74,3,IIf([age] Between 75 And 79,4,IIf([age] Between 80 And 84,5,IIf([age] Between 85 And 90,6))))))) AS Valage,
 IIf([Sexe]="Homme",0,IIf([Sexe]="Femme",1)) AS valsexe,
 IIf([BPCO]=Yes,1,IIf([BPCO]=No,0)) AS valbpco,
 IIf([arteriopathie]=Yes,2,IIf([arteriopathie]=No,0)) AS valarteriopathie,
 IIf([neuro]=Yes,2,IIf([neuro]=No,0)) AS valneuro,
 IIf([reprise]=Yes,3,IIf([reprise]=No,0)) AS valreprise,
 (((140-[age])*[Poids])/(0.81*[creat]))*[sexecocroft] AS Cocroft,
 IIf([Sexe]="Homme",1,IIf([Sexe]="Femme",0.85)) AS sexecocroft, 
IIf([creat]<200,0,IIf([creat]=200,0,IIf([creat]>200,2))) AS valcreat,
 IIf([endocardite]=Yes,3,IIf([endocardite]=No,0)) AS valendocardite,
 IIf([preop]=Yes,3,IIf([preop]=No,0)) AS valpreop, 
IIf([angor]=Yes,2,IIf([angor]=No,0)) AS valangor, 
IIf([fe]>=50,0,IIf([fe]=0,0,IIf([fe] Between 49 And 31,1,IIf([fe]<=30,3)))) AS valfe,
 IIf([idmrecent]=Yes,2,IIf([idmrecent]=No,0)) AS validmrecent,
 IIf([pap]="< 60",0,IIf([pap]="> ou = 60",2)) AS valpap,
 IIf([urgence]=Yes,2,IIf([urgence]=No,0)) AS valurgence, 
IIf([autreCABG]=Yes,2,IIf([autreCABG]=No,0)) AS valautrecabg, 
IIf([aortethoracique]=Yes,3,IIf([aortethoracique]=No,0)) AS valaortethoracique,
 IIf([CIVpostidm]=Yes,4,IIf([CIVpostidm]=No,0)) AS valcivpostidm, 
[Valage]+[valsexe]+[valbpco]+[valarteriopathie]+[valneuro]+[valreprise]+[valcreat]+[valendocardite]+[valpreop]+[valangor]+[valfe]+[validmrecent]+[valpap]+[valurgence]+[valautrecabg]+[valaortethoracique]+[valcivpostidm] AS total,
 T_Intervention.BPCO, T_Intervention.arteriopathie, T_Intervention.neuro, T_Intervention.[Atcd pontage(s)], IIf([did]=True Or [dnid]=True,"OUI","NON") AS Diabete, T_Intervention.reprise, T_Intervention.creat, T_Intervention.endocardite, T_Intervention.preop, T_Intervention.angor, T_Intervention.idmrecent, T_Intervention.urgence, T_Intervention.aortethoracique, T_Intervention.CIVpostidm, ([Xi]*0.0666354) AS LValage,
 IIf([valsexe]=0,"0","0,3304052") AS Lvalsexe, 
IIf([valarteriopathie]=0,"0","0,6558917") AS Lvalarteriopathie, 
IIf([valneuro]=0,"0","0,8411626") AS Lvalneuro, 
IIf([valreprise]=0,"0","1,002625") AS Lvalreprise, 
IIf([Valcreat]=0,"0","0,6521653") AS Lvalcreat, 
IIf([valendocardite]=0,"0","1,101265") AS Lvalendocardite,
 IIf([valpreop]=0,"0","0,9058132") AS Lvalpreop, 
IIf([valangor]=0,"0","0,5677075") AS Lvalangor, 
IIf([valfe]=1,"0,4191643",IIf([valfe]=3,"1,094443",IIf([valfe]=0,"0"))) AS Lvalfe,
 IIf([validmrecent]=0,"0","0,5460218") AS Lvalidmrecent, 
IIf([valpap]=0,"0","0,7676924") AS Lvalpap, 
IIf([valurgence]=0,"0","0,7127953") AS Lvalurgence, 
IIf([valautrecabg]=0,"0","0,5420364") AS Lvalautrecabg, 
IIf([valaortethoracique]=0,"0","1,159787") AS Lvalaortethoracique, 
-4.789594+[LValage]+[Lvalsexe]+[Lvalbpco]+[Lvalarteriopathie]+[Lvalneuro]+[Lvalreprise]+[Lvalcreat]+[Lvalendocardite]+[Lvalpreop]+[Lvalangor]+[Lvalfe]+[Lvalidmrecent]+[Lvalpap]+[Lvalurgence]+[Lvalautrecabg]+[Lvalaortethoracique]+[Lvalcivpostidm] AS SLtotal,
 IIf(IsNumeric([SLtotal]),Exp([SLtotal])/(1+Exp([SLtotal])),"") AS LTotal,
 IIf([age]<60,1,IIf([age]>60 Or [age]=60,[age]-58)) AS Xi, 
IIf([valbpco]=0,"0","0,4931341") AS Lvalbpco, 
IIf([valcivpostidm]=0,"0","1,426009") AS Lvalcivpostidm,
 T_Intervention.[Hte preop], T_Intervention.PlaqDépart, IIf(([age]+1)*0.0285181<=1.711086,0.0285181,(([age]+1)-60)*0.0285181) AS Lvalage2,
IIf([sexe]="Homme",0,0.2196434) AS Lvalsexe2, 
IIf([arteriopathie]=False,0,0.5360268) AS Lvalarteriopathie2, 
IIf([neuro]=False,0,0.2407181) AS Lvalneuro2, 
IIf([reprise]=False,0,1.118599) AS Lvalreprise2,
 IIf([T_intervention]![dialyse]=1,0.6421508,IIf([Cocroft]>85,0,IIf([Cocroft] Between 50 And 84.99,0.303553,IIf([Cocroft]<50,0.8592256)))) AS Lvalcreat2,
 IIf([endocardite]=False,0,0.6194522) AS Lvalendocardite2,
 IIf([preop]=False,0,1.086517) AS Lvalpreop2, IIf([angor]=False,0,0.2226147) AS Lvalangor2, 
T_Intervention.fe, IIf([fe]>=50,0,IIf([fe] Between 49.99 And 31,0.3150652,IIf([fe] Between 30.99 And 21,0.8084096,IIf([fe]<20.99,0.9346919)))) AS Lvalfe2,
 IIf([idmrecent]=False,0,0.1528943) AS Lvalidmrecent2,
 T_Intervention.pap, IIf([pap2]="< ou = 30",0,IIf([pap2]="31 à 55",0.1788899,IIf([pap2]="> 55",0.3491475))) AS Lvalpap2, 
IIf([urgence]=True,1.362947,IIf([urgence]=False,0,IIf([urgence2]="Programmée",0,IIf([urgence2]="Urgence relative",0.3174673,IIf([urgence2]="Urgence <24h",0.7039121,IIf([urgence2]="Sauvetage",1.362947)))))) AS Lvalurgence2, 
T_Intervention.autreCABG, IIf([autrecabg2]="Pontages seuls" Or [autrecabg]=False,0,IIf([autrecabg2]="1 chir majeure" Or [civpostidm]=True,0.0062118,IIf([autrecabg2]="2 chir majeures" Or [autrecabg]=True,0.5521478,IIf([autrecabg2]=">=3  chir majeures",0.9724533)))) AS Lvalautrecabg2, 
IIf([aortethoracique]=False,0,0.6527205) AS Lvalaortethoracique2, 
IIf([did]=False,0,0.3542749) AS Ldiabete2,
IIf([T_intervention]![NYHA]="1",0,IIf([T_intervention]![NYHA]="2",0.1070545,IIf([T_intervention]![NYHA]="3",0.2958358,IIf([T_intervention]![NYHA]="4",0.5597929)))) AS LNYHA2,
T_Intervention.NYHA, IIf([valbpco]=False,0,0.1886564) AS Lvalbpco2, T_Intervention.urgence2, T_Intervention.autreCABG2, [LValage2]+[Lvalsexe2]+[Lvalbpco2]+[Lvalarteriopathie2]+[Lvalneuro2]+[Lvalreprise2]+[Lvalcreat2]+[Lvalendocardite2]+[Lvalpreop2]+[Lvalangor2]+IIf([Lvalfe2] Is Null,0,[Lvalfe2])+[Lvalidmrecent2]+IIf([Lvalpap2] Is Null,0,[Lvalpap2])+IIf([Lvalurgence2] Is Null,0,[Lvalurgence2])+IIf([Lvalautrecabg2] Is Null,0,[Lvalautrecabg2])+[Lvalaortethoracique2]+[Ldiabete2]+IIf([LNYHA2] Is Null,0,[LNYHA2]) AS Ltotal2,
 [Ltotal2]-5.324537 AS SLtotal2, 
IIf(IsNumeric([SLtotal2]),Nz(Exp([SLtotal2])/(1+Exp([SLtotal2])),""),"") AS Euroscore2,
 Nz([total],"") AS [EUROSC ADD], IIf(IsNumeric([LTotal]),Nz([Ltotal],""),"") AS [EUROSC LOG],
 T_Intervention.dialyse, T_Patient.did, T_Intervention.pap2, T_Patient.obesite_sup40, T_Patient.obesite_inf40, T_Patient.BPCO_atcd, T_Patient.AOMI_atcd
 
FROM (T_Patient INNER JOIN T_sejour ON T_Patient.ID_Patient = T_sejour.ID_Patient) INNER JOIN T_Intervention ON T_sejour.ID_sejour = T_Intervention.ID_sejour;

[marsouin_89]

Bonjour,

Je me suis amusé à me pencher sur ton problème.
Essaies donc ceci :

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
Sub splitSql(sSql As String)
 
Dim TabAs() As String
Dim Txt1 As String
Dim Txt2 As String
 
'Extraction des fractions de phrase séparées par le mot As
TabAs = split(sSql, "as")
Dim i As Long
 
For i = LBound(TabAs) To UBound(TabAs)  'Parcoure du tableau
    If i <> 0 Then
        If InStr(TabAs(i - 1), "iif") > 0 Then
            Txt1 = Mid(TabAs(i - 1), InStr(TabAs(i - 1), "iif") + 1)
        Else
            Txt1 = Mid(TabAs(i - 1), InStrRev(TabAs(i - 1), ",") + 1)
        End If
        Txt2 = Mid(TabAs(i), 1, InStr(TabAs(i), ",") - 1)
        MsgBox Trim(Txt1 & " as " & Txt2)
    End If
Next i
End Sub

Cordialement

Christophe

[docjo]

Merci Christophe.

Finalement, c'est pas si bricolage que ça.

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
82
83
84
85
86
87
88
89
90
91
 
Public Function ExportQueryFields(QryName As String)
 
 
    Dim lFld As Long
    Dim dBase As Database
    Dim xlApp As Object
    Dim wbExcel As Object
    Dim lRow As Long
    Dim qdf As DAO.QueryDef
 
 
     'Détermine la base actuelle et crée une nouvelle instance excel
    Set dBase = CurrentDb
    Set xlApp = CreateObject("Excel.Application")
    Set wbExcel = xlApp.workbooks.Add
    Set qdf = dBase.QueryDefs(QryName)
 
     'Gestion des erreurs
    On Error Resume Next
 
    'Ajout de colonnes
    lRow = 1
    With wbExcel.sheets(1)
        .Range("A" & lRow) = "Nom Requete"
        .Range("B" & lRow) = "Nom Champ"
        .Range("C" & lRow) = "Type"
        .Range("D" & lRow) = "Taille"
        .Range("E" & lRow) = "Code SQL"
 
    End With
 
     'Selection de la requete
     With qdf
             'Ecriture de chaque champ
            For lFld = 0 To qdf.Fields.Count - 1
                lRow = lRow + 1
                With wbExcel.sheets(1)
                    .Range("A" & lRow) = qdf.Name
                    .Range("B" & lRow) = qdf.Fields(lFld).Name
                    .Range("C" & lRow) = qdf.Fields(lFld).Type
                    .Range("D" & lRow) = qdf.Fields(lFld).Size
                    'Ici le champ où il faut trouver le code SQL des "As"
                    .Range("E" & lRow) = splitSql(qdf.sql, qdf.Fields(lFld).Name)
                End With
            Next lFld
 
 
    End With
 
    On Error GoTo 0
 
    xlApp.Visible = True
    Set xlApp = Nothing
    Set wbExcel = Nothing
    Set dBase = Nothing
 
End Function
Private Function splitSql(sSql As String, NameFld As String) As String
 
Dim TabAs() As String
Dim TabSql() As String
Dim Txt1 As String
Dim Txt2 As String
 
'Gestion des erreurs
On Error Resume Next
 
'Extraction des fractions de phrase séparées par le mot As
TabAs = Split(sSql, "as " & NameFld & ",")
'Gestion de l'espace dans le nom
TabSql = Split(sSql, "as [" & NameFld & "]")
 
Dim i As Long
 
For i = LBound(TabAs) To UBound(TabAs)  'Parcours du tableau
    If i <> 0 Then
        Txt1 = Mid(TabAs(i - 1), InStrRev(TabAs(i - 1), ", ") + 1)
        splitSql = Txt1
        Else
        splitSql = NameFld
    End If
Next i
For i = LBound(TabSql) To UBound(TabSql)  'Parcours du tableau
    If i <> 0 Then
        Txt2 = Mid(TabSql(i - 1), InStrRev(TabSql(i - 1), ", ") + 1)
        splitSql = Txt2
    End If
Next i
 
End Function

Ce code fonctionne parfaitement pour moi. Probablement à améliorer.
Encore Mille mercis.

JC