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 |
