Discussion :

[cafeine]

Bonjour à tous,

Une solution pour utiliser rapidement du SQL sur une plage de données.
Personnellement j'ai intégré un formulaire pour écrire la requête et rafraichir en macro complémentaire, mais c'est utilisable tel quel.


Voici le code (à lettre dans un module) :
NB : utilisation de DAO sans nécessité d'ajouter une référence.

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
Option Explicit
 
Sub RefreshSQL()
 
Dim res As Range
Dim firstAddress As String
 
    With ActiveSheet.Cells
        Set res = .Find(What:="RUNSQL", After:=ActiveCell, LookIn:=xlFormulas _
            , LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
 
        If Not res Is Nothing Then
            firstAddress = res.Address
            Do
                'Debug.Print res.Address, res.Value
                If res.Value Like "RUNSQL:SOURCE=*" Then
                    ' exécution du SQL
                    Dim db As Object, dbEng As Object, rec As Object
                    Dim txtSource As String, txtTarget As String
                    Dim txtSQL As String, chkTitre As String, sSQL As String
                    Dim rt As Range, rs As Range
 
                    txtSource = Split(Split(res.Value, "SOURCE=")(1), ";TITRE=")(0)
                    chkTitre = CInt(Split(Split(res.Value, "TITRE=")(1), ";CMD=")(0))
                    txtSQL = Split(res.Value, ";CMD=")(1)
                    Set rs = Range(txtSource)
                    Set rt = res.Offset(1, 0)
 
                    Set dbEng = CreateObject("DAO.DBEngine.36")
                    Set db = dbEng.Workspaces(0).OpenDatabase(rs.Parent.Parent.FullName, _
                                              False, _
                                              False, _
                                              "Excel 8.0;HDR=" & _
                                    IIf(chkTitre = True, "YES", "NO") & ";")
 
                    sSQL = Replace(txtSQL, "<Table>", "[" & rs.Parent.Name & "$" & rs.Address(False, False, xlA1) & "]")
                    Set rec = db.OpenRecordset(sSQL, 4)
                    rt.CopyFromRecordset rec
                    rec.Close
 
                    Set dbEng = Nothing
                    Set db = Nothing
                    Set rs = Nothing
 
                End If
                Set res = .Find(What:="RUNSQL", After:=res, LookIn:=xlFormulas _
                        , LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)
            Loop While Not res Is Nothing And res.Address <> firstAddress
        End If
    End With
 
Set res = Nothing
 
End Sub