Discussion :

[XlsmInProgress]

Bonjour à tous,

Je me tourne vers le forum pour la première fois de manière active car je n'ai pas réussi à trouver la solution à mon problème en fouillant un peu sur le web.

Je début en VBA et suis en train de coder une macro qui permet, à l'ouverture d'un classeur, d'actualiser une requête provenant d'une URL et ensuite de récupérer les données actualisées pour les copier/coller dans d'autres classeurs. Mon problème est que le code permettant de copier/coller les données s'active avant que la requête ne termine de s'actualiser... J'ai essayé plusieurs choses : BackgroundQuery:= false, Application.wait, appel de plusieurs macros, DoEvents lors du Refresh de la requête... rien n'y fait, les données copiées sont celles qui n'ont pas encore été actualisées.

Ci-dessous le code que j'utilise. Par ailleurs, étant relativement débutant sur VBA, je suis preneur de toute remarque sur le code en termes de syntaxe et de lisibilité.

Je vous remercie pour votre aide.

Bonne journée !

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
Private Sub Workbook_Open()
 
Dim DataTable As QueryTable
 
With Sheets("TabQuery")
    If MsgBox("Activer requête?", vbYesNo) = vbYes Then
        For Each DataTable In Sheets("TabQuery").QueryTables
            DataTable.Refresh BackgroundQuery:=False
            DoEvents
        Next
 
Application.Wait (Now + TimeValue("0:00:30"))
 
Sheets("TabQuery").Select
 
        [L2] = Format(Date, "mm/dd/yyyy")
        [L3] = Format(Time, "hh:mm:ss")
 
        If [L3] <= 0.354166666666667 Then
            [L2] = Date - 1
            [M2] = "Last"
        ElseIf [L3] >= 0.75 Then
            [M2] = "Current"
        Else
            [M2].ClearContents
        End If
 
        Call AddData
 
    'End With
   '
Else
    Exit Sub
End If
 
End With
 
End Sub
 
 
Sub AddData()
 
Dim i, j As Integer
Dim DateNumber As Long
Dim LastRow, LastRowSource, LastRowAdded As Long
Dim wb As Workbook
Dim SourceFileName As String
Dim FindValue As Range
 
If Sheets("TabQuery").[M2] <> "" Then
    FilePath = Sheets("Base").[J3]
 
    LastRow = Sheets("TabQuery").Range("A65536").End(xlUp).Row
    DateNumber = CLng(Sheets("TabQuery").Range("L2"))
 
    For i = 2 To 2 'LastRow
        For j = 3 To 3 'LastRow + 1 
            If Sheets("TabQuery").Cells(i, 1) = Sheets("Base").Cells(j, 6) Then
 
                SourceFileName = Sheets("Base").Cells(j, 4)
                Set wb = Workbooks.Open(FilePath & SourceFileName & ".xlsx")
                LastRowSource = Workbooks(SourceFileName & ".xlsx").Sheets(1).Range("A65536").End(xlUp).Row
 
                With Workbooks(SourceFileName & ".xlsx").Sheets(1).Range("B2:B" & LastRowSource)
                Set FindValue = .Find(DateNumber, LookIn:=xlValues)
                    If Not FindValue Is Nothing Then
                        Workbooks(SourceFileName & ".xlsx").Close
                        Exit Sub
                    Else
 
                        Workbooks(SourceFileName & ".xlsx").Sheets(1).Cells(LastRowSource + 1, 1) = Workbooks(SourceFileName & ".xlsx").Sheets(1).Cells(LastRowSource, 1)
                        Workbooks(SourceFileName & ".xlsx").Sheets(1).Cells(LastRowSource + 1, 2) = Workbooks("QueryFile.xlsm").Sheets("TabQuery").[L2]
                        Workbooks(SourceFileName & ".xlsx").Sheets(1).Cells(LastRowSource + 1, 3) = Workbooks("QueryFile.xlsm").Sheets("TabQuery").Cells(i, 4)
                        Workbooks(SourceFileName & ".xlsx").Sheets(1).Cells(LastRowSource + 1, 4) = Workbooks("QueryFile.xlsm").Sheets("TabQuery").Cells(i, 5)
                        Workbooks(SourceFileName & ".xlsx").Sheets(1).Cells(LastRowSource + 1, 5) = Workbooks("QueryFile.xlsm").Sheets("TabQuery").Cells(i, 6)
                        Workbooks(SourceFileName & ".xlsx").Sheets(1).Cells(LastRowSource + 1, 6) = Workbooks("QueryFile.xlsm").Sheets("TabQuery").Cells(i, 2)
                        Workbooks(SourceFileName & ".xlsx").Sheets(1).Cells(LastRowSource + 1, 7) = Workbooks("QueryFile.xlsm").Sheets("TabQuery").Cells(i, 7)
                        Workbooks(SourceFileName & ".xlsx").Close True
 
                        Workbooks("QueryFile.xlsm").Activate
                        LastRowAdded = Sheets("TrackAddedValues").Range("A65536").End(xlUp).Row
                        Sheets("TrackAddedValues").Cells(LastRowAdded + 1, 1) = Sheets("TabQuery").[L2]
                        Sheets("TrackAddedValues").Cells(LastRowAdded + 1, 2) = Sheets("TabQuery").[M2]
                        Sheets("TrackAddedValues").Cells(LastRowAdded + 1, 3) = Format(Date, "mm/dd/yyyy")
                        Sheets("TrackAddedValues").Cells(LastRowAdded + 1, 4) = Sheets("TabQuery").[L3]
                    End If
                End With
            End If
        Next
    Next
End If
 
 
End Sub

[XlsmInProgress]

J'ai finalement résolu mon problème comme un grand J'ai séparé l'actualisation de la requête du message d'initialisation, et je suis passé par un bout de code récupéré via l'enregistreur lorsque l'on désactive l'actualisation en arrière plan dans la boite de dialogue. A priori l'objet OLEDBConnection permet d'être plus précis sur les propriétés de la requête.

Le seul biais : la requête s'actualise même si la réponse au msgbox est "Non". Seul le traitement des données ne sera pas traité si la réponse est non mais la requête se mettra quand même à jour. Pas impactant dans mon cas mais à savoir pour ceux qui lisent ce post.

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
 
Private Sub Workbook_Open()
 
Dim DataTable As QueryTable
 
With ActiveWorkbook.Connections("Requête*-*Table 0 (2)").OLEDBConnection
    .BackgroundQuery = False
    .CommandText = Array("SELECT * FROM [Table 0 (2)]")
    .CommandType = xlCmdSql
    .RefreshOnFileOpen = True
End With
ActiveWorkbook.Connections("Requête*-*Table 0 (2)").Refresh
DoEvents
 
If MsgBox("Activer requête?", vbYesNo) = vbYes Then
...