Discussion :

[Phil Free]

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 :

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

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

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

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

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

[Phil Free]

Un petit up pour dire que l'on ma fait un retour sur le fait que cela ne fonctionne pas pour les requêtes vers access !!!
enfin... jusqu’à preuve du contraire