Attendre la fin de l'actualisation des tables de données (QueryTables) via la classe d'evenements QueryTable
Bonjour,
il y a quelques temps j'ai répondu à une discussion ici
à propos de l'attente de la fin de l'actualisation des tables de données externes. Hélas l'auteur du poste n'a jamais répondu or le sujet m’intéresse pour 2 raisons
La première est que j'ai eu à résoudre ce problème pour l’importation de donnée issues de base accessible uniquement via une interface Web et qu'il m'a fallut trouver le moyen d'attendre la fin de l'actualisation. D'autant que le réseau est assez capricieux et peut significativement augmenter le temps de mise à jour. Donc dans un tel cas il n'était pas pensable d'utiliser une tempo.
De plus je n'ai trouver aucun forum ou source qui proposait d'utiliser les evenements de la classe Querytable
La deuxième raison est que j'aurais aimé savoir si cela fonctionne sur les autres type de Querytables
Du coup si une ou plusieurs âmes charitables pouvais faire le teste avec d'autre type de Querytables cela permettrais de mieux partager cette solution.
Vous trouverez le type de table rafraîchie qui s'écrit dans la fenêtre d’exécution.
De plus je propose une amélioration de ce que j'ai posté, avec cette fois si la possibilité de non plus mettre à jour les tables une par une mais avec la méthode RefreshAll.
Refreshall a l'avantage de paralléliser l'actualisation des tables alors que ma solution précédente sérialisait l'actualisation.
Ce qui permet d’accélérer grandement la mise à jour si le fichier contient plusieurs tables.
Voici le code :
Dans le code ThisWorkBook :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
Option Explicit
Private Sub Workbook_Activate()
Call XlAppli.InitQueryEvent(Me)
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
XlAppli.EmptyQtClass
End Sub
Private Sub Workbook_Deactivate()
XlAppli.EmptyQtClass
End Sub
Private Sub Workbook_Open()
Set XlAppli.Xl = Excel.Application 'on charge la classe
Call XlAppli.InitQueryEvent(Me) 'on recupere toutes les querytables afin de les associées à leur classe d'evenements
End Sub |
En partie haute d'un module on colle le code suivant :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
|
Option Explicit
'optionnel permettra par la suite de redonner le focus à excel en cas de demande éventuelle de mot de passe en début de requête
Declare Function SetForegroundWindow Lib "User32" (ByVal hwnd As Long) As Long
'permettra de vérifier qu'une connexion réseau existe
Declare Function InternetGetConnectedState Lib "wininet.dll" (lpdwFlags As Long, ByVal dwReserved As Long) As Boolean
Public RefreshISDone As Boolean
Public XlAppli As New XlClass
Function ConnexionStatus() As Boolean
'Verifi l'etat de la connection reseau
Dim Status As Long
ConnexionStatus = (InternetGetConnectedState(Status, 0&) <> 0)
End Function |
on ajoute au projet un module de classe nommé XlClass
Et on lui colle le code suivant :
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
| Option Explicit
Public WithEvents Xl As Excel.Application
Dim Tableqt() As ClsModQT
Public Sub InitQueryEvent(Wkb As Workbook)
'ici on associe les querytables à leur classe d'evenements
'on verifi que c'est bien le type d'objet attendu. Ici un workbook
If TypeOf Wkb Is Workbook Then
Dim Requete As QueryTable
Dim Feuille As Worksheet
Dim i As Integer
i = 1
For Each Feuille In Wkb.Worksheets
If Feuille.QueryTables.Count > 0 Then
If i = 1 Then
ReDim Preserve Tableqt(Feuille.QueryTables.Count)
Else
ReDim Preserve Tableqt(UBound(Tableqt) + Feuille.QueryTables.Count)
End If
For Each Requete In Feuille.QueryTables
Set Tableqt(i) = New ClsModQT
Set Tableqt(i).qtQueryTable = Requete
i = i + 1
Next
End If
Next
End If
End Sub
'Permet de vider la classe
Public Sub EmptyQtClass()
Dim j As Integer
On Error Resume Next
For j = 1 To UBound(Tableqt)
Set Tableqt(j) = Nothing
Next
End Sub |
On ajoute un 2ieme module de classe que tu nommes ClsModQT
puis on lui colles le code suivant :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
| Option Explicit
'si quelqu'un voit une façon plus élégante que celle proposée ici afin de gérer la méthode refreshall sera le bien venu !
Public WithEvents qtQueryTable As QueryTable
Public NbQueryTableRefreshOn As Long, NbQueryTableRefreshOff As Long
Private Sub qtQueryTable_AfterRefresh(ByVal Success As Boolean)
If Success = True Then NbQueryTableRefreshOff = NbQueryTableRefreshOff + 1 'ici on compte le nombre de table actualisées avec succès
If NbQueryTableRefreshOff = NbQueryTableRefreshOn Then 'on compare le nombre de table actualisées avec le nombre de table à actualiser
RefreshISDone = Success
NbQueryTableRefreshOff = 0
NbQueryTableRefreshOn = 0
End If
Debug.Print qtQueryTable.Parent.Name & " refresh done ! "
End Sub
Private Sub qtQueryTable_BeforeRefresh(Cancel As Boolean)
NbQueryTableRefreshOn = NbQueryTableRefreshOn + 1 'ici on compte le nombre de tables qui seront actualisées
Debug.Print "Query tables On " & qtQueryTable.Parent.Name & " refreshing in progress..."
Debug.Print "Type de la table : " & qtQueryTable.QueryType 'le type de table à actualiser
End Sub |
Voila la méthode n'est pas simple à mettre en place mais fonctionne de mon coté
petit rappel :
/!\ En générale quand on utilise des modules de classe il est préférable de lancer les macros de test depuis excel et pas depuis l’éditeur VBA
/!\ toutes modifications du code dans un module de class doit être suivi d'un rechargement de la classe !!! cela peut être fait en exécutant "Workbook_Open" du module ThisWorkbook et ce depuis l’éditeur VBA. Exception à la règle précédente
/!\ tout ajout de table de requêtes dans le classeur doit être suivit d'un rechargement de la classe afin d'être prise en compte par la classe d'evenement. Soit comme expliqué précédemment ou par une fermeture du classeur puis une réouverture.
Maintenant un code de demo à mettre dans le module ou ce trouve, entre autre, la déclaration de la variable "Public RefreshISDone As Boolean" :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
Sub DemoRefreshAll()
If ConnexionStatus = True Then
Debug.Print "Debut test refresh all..."
RefreshISDone = False
ThisWorkbook.RefreshAll
Do
DoEvents
If RefreshISDone = True Then Exit Do
Loop
MsgBox "all refreshs are done !"
Else
MsgBox "The status of Your Connexion is 'disconnected' !", vbExclamation, " Connection error..."
End if
End Sub |
Voila merci d'avance à celles et ceux qui auront le courage de tester tout cela et de me faire un retour.
Philippe
