[DAO] fonctions de domaine équivalentes à celles d'Access

[cafeine]

Bonjour,

Il faut impérativement ajouter la référence DAO à votre classeur Excel

en extension à la source précédente, voici des équivalents des fonctions de domaine Access pour Excel.
Cette fois le code permet d'interroger des plages d'un autre classeur et cela même s'il est fermé ...

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
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
Function DQuery(ByVal Operation As String, _
                ByVal Champ As String, _
                ByRef TableRange, _
                Optional ByVal ConditionWhere As String)
 
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim sql As String
 
    ' regarde si le classeur interrogé est fermé ou non ...
    If TypeName(TableRange) = "Range" Then
 
        Set db = DAO.OpenDatabase(TableRange.Parent.Parent.FullName, False, False, "Excel 8.0;HDR=YES;")
        sql = "SELECT " & Operation & "([" & Champ & "]) " & _
              "FROM [" & TableRange.Parent.Name & "$" & TableRange.Address(0, 0) & "] " & _
              IIf(ConditionWhere & "" <> "", _
                  "WHERE " & ConditionWhere, _
                  vbNullString)
    Else
    ' sinon on cherche dans la formule l'adresse
    ' sur le type
    ' 'Lecteur:\repertoire\[fichier.xls]feuille'!A12:B50
        Dim wbk As String
        Dim wsh As String
        Dim rng As String
 
        wbk = Replace(Replace(Split(TableRange, "]")(0), "[", vbNullString), "'", vbNullString)
        wsh = Replace(Split(Split(TableRange, "]")(1), "!")(0), "'", vbNullString)
        rng = Replace(Split(TableRange, "!")(1), "$", vbNullString)
 
        Set db = DAO.OpenDatabase(wbk, False, False, "Excel 8.0;HDR=YES;")
        sql = "SELECT " & Operation & "([" & Champ & "]) " & _
              "FROM [" & wsh & "$" & rng & "] " & _
              IIf(ConditionWhere & "" <> "", _
                  "WHERE " & ConditionWhere, _
                  vbNullString)
 
    End If
 
    Set rs = db.OpenRecordset(sql, _
                              DAO.dbOpenSnapshot)
    If rs.EOF And rs.BOF Then
        DQuery = "Aucun résultat"
    Else
        DQuery = rs.Fields(0)
    End If
 
    Set rs = Nothing
    Set db = Nothing
 
End Function
 
 
Function DLookUp(ByVal Champ As String, ByVal TableRange As Range, _
                 Optional ByVal ConditionWhere As String)
 
    If TypeName(TableRange) = "Range" Then
        DLookUp = DQuery("", Champ, TableRange, ConditionWhere)
    Else
        Dim s As String
        s = Split(Application.Caller.Formula, ",")(1)
        DLookUp = DQuery("", Champ, s, ConditionWhere)
    End If
 
End Function
 
 
Function DSum(ByVal Champ As String, ByVal TableRange As Range, _
                 Optional ByVal ConditionWhere As String)
 
    If TypeName(TableRange) = "Range" Then
        DSum = DQuery("SUM", Champ, TableRange, ConditionWhere)
    Else
        Dim s As String
        s = Split(Application.Caller.Formula, ",")(1)
        DSum = DQuery("SUM", Champ, s, ConditionWhere)
    End If
 
End Function
 
Function DMin(ByVal Champ As String, ByVal TableRange As Range, _
                 Optional ByVal ConditionWhere As String)
 
    If TypeName(TableRange) = "Range" Then
        DMin = DQuery("MIN", Champ, TableRange, ConditionWhere)
    Else
        Dim s As String
        s = Split(Application.Caller.Formula, ",")(1)
        DMin = DQuery("MIN", Champ, s, ConditionWhere)
    End If
 
End Function
 
Function DMax(ByVal Champ As String, ByVal TableRange, _
                 Optional ByVal ConditionWhere As String)
 
    If TypeName(TableRange) = "Range" Then
        DMax = DQuery("MAX", Champ, TableRange, ConditionWhere)
    Else
        Dim s As String
        s = Split(Application.Caller.Formula, ",")(1)
        DMax = DQuery("MAX", Champ, s, ConditionWhere)
    End If
 
End Function
 
Function DCount(ByVal Champ As String, ByVal TableRange, _
                 Optional ByVal ConditionWhere As String)
 
    If TypeName(TableRange) = "Range" Then
        DCount = DQuery("COUNT", Champ, TableRange, ConditionWhere)
    Else
        Dim s As String
        s = Split(Application.Caller.Formula, ",")(1)
        DCount = DQuery("COUNT", Champ, s, ConditionWhere)
    End If
 
End Function

Exemples d'utilisation :

Code :

1
2
3
4
=dcount("prénom";A3:A9)
=dmax("age";A3:D9)
=dlookup("nom";$A$3:$D$9;"[prénom] = 'Bernard'")
=dsum("age";C3:D9;"[Permis] = 'a'")