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