[VBA] Laisser actif un popup durant le chargement d'un formulaire

Bonjour à tous,

petite question qui trouvera à coup sûre une réponse.

Peut-on laisser afficher un popup durant la durée de chargement d'un formulaire?

Sub AppelerUserForm()

Call Tri_macro
assist.Show
CreateObject("WScript.Shell").Popup "Veuillez patienter pendant le chargement de l'assistant (10 sec env.)", 3, "Chargement en cours..."
Dim xAF As AutoFilter
    Dim xFs As Filters
    Dim xLos As ListObjects
    Dim xLo As ListObject
    Dim xRg As Range
    Dim xWs As Worksheet
    Dim xIntC, xF1, xF2, xCount As Integer
    Application.ScreenUpdating = False
    On Error Resume Next
    For Each xWs In Application.Worksheets
        xWs.ShowAllData
        Set xLos = xWs.ListObjects
        xCount = xLos.Count
        For xF1 = 1 To xCount
         Set xLo = xLos.Item(xF1)
         Set xRg = xLo.Range
         xIntC = xRg.Columns.Count
         For xF2 = 1 To xIntC
            xLo.Range.AutoFilter Field:=xF2
         Next
        Next
    Next
    Application.ScreenUpdating = True
End Sub

Cet extrait de code me permet d'ouvrir un formulaire contenant les différents outils que j'utilise.

Je suis contraint de retirer les filtres actifs sur l'ensemble de mes feuilles avant de manipuler les données. Cette action prend environ une petite dizaine de seconde.

Puis-je afficher un popup durant le chargement du formulaire?

Dans mon code le popup apparait avant et le retrait des filtres s'effectue après sa disparition.

VBA fonctionnant étape par étape je me dis que cela peut ne pas être possible, mais j'en appelle à des personnes plus expérimentées pour avoir la bonne parole.

Autre point, le popup est accompagné d'un bouton "OK", peut on insérer un popup sans bouton de validation?

Merci à vous

bonjour Sitting_Bull,

avec ceci vous utilisez un forme comme popup dans la feuille "blad1", on peut faire quelque chose pareil dans votre UF.

Merci pour votre retour.

Pourriez vous m'expliquer cette ligne

 Set pict = Sheets("blad1").Shapes("Pacientez")

en effet je comprends la nécessité de remplacer dans mon cas le "blad1", cependant, le shapes fait appel à quoi?

re,

j'ai ajouté une forme dans la feuille active au moment du popup. Voir dans ce fichier l'image.

• dans le ruban, je chois "insérer" (1), "forme" (2) et puis cette forme en bas (3)
• dans ma feuille je clique quelque part avec le souris gauche
• maintenez et faites glisser vers le bas + droite et relâchez
• Maintenant vous avez cette forme et vous ajoutez du texte là dedans, vous modifiez le font, ...
• Important, vous changez le nom (4) de cette forme en, par exemple "pacientez" et vous utilisez ce nom dans la macro.

Maintenant cette forme est prêt et vous n'avez que le montrer ou cacher au moment et à l'endroit (dans cette feuille) que vous voulez

Bonsoir Sitting_bull,

BsAlv bonsoir,

Une proposition avec un USF Modal 0 qui s'affiche au lancement du USF principal et qui s'efface à l'issu de la fin du traitement (ici c'est une copie multiple de LouReeD sur la feuille ! )

Le fichier :

Avantage : il reste visible quelque soit la durée du traitement pas de gestion d'image. Vous pouvez mettre une image en fond du USF.

@ bientôt

LouReeD

Génial!

Merci à BsAlv pour cette explication.

en adaptant ton code LouReedD j'arrive à qqch qui me satisfait.

Mais...il y a un petit mais

Dim xAF As AutoFilter
    Dim xFs As Filters
    Dim xLos As ListObjects
    Dim xLo As ListObject
    Dim xRg As Range
    Dim xWs As Worksheet
    Dim xIntC, xF1, xF2, xCount As Integer
    Application.ScreenUpdating = False
    On Error Resume Next
    For Each xWs In Application.Worksheets
        xWs.ShowAllData
        Set xLos = xWs.ListObjects
        xCount = xLos.Count
        For xF1 = 1 To xCount
         Set xLo = xLos.Item(xF1)
         Set xRg = xLo.Range
         xIntC = xRg.Columns.Count
         For xF2 = 1 To xIntC
            xLo.Range.AutoFilter Field:=xF2
         Next
        Next
    Next
    Application.ScreenUpdating = True
End Sub

L'insertion de ce code au milieu de la mise en oeuvre du popup d'attente fonctionne, mais le retrait des filtres prend bcp de temps.

Puis-je indiquer sur quelle feuille il doit l'effectuer ce tri? Mes différents tableaux portent des noms, si j'indique avant mon Dim un With, je devrais en théorie obtenir un résultat qui cible bien les tableaux pour lesquels je souhaite retirer le filtre.

Qu'en pensez vous?

Bonsoir,

Alors là comme ça je ne sais que vous dire... Je ne maitrise pas à fond tout ce qui touche aux tri/filtre par VBA.

@ bientôt

LouReeD

re,

cà sert à quoi ce boucle ????

Si on a déjà cà "xWs.ShowAllData"

vous avez max. combien de tableaux par feuille ? Et en total ?

xIntC = xRg.Columns.Count
         For xF2 = 1 To xIntC
            xLo.Range.AutoFilter Field:=xF2
         Next

Salut Bs Alv

Je vais essayer de préciser mon besoin.

Je dispose d'un fichier excel comportant une trentaine de feuilles.

Sur certaines feuilles j'ai inséré jusqu'à 15 tableaux.

Le code lui implémente des données sur 6 feuilles de mon classeur et non pas les 30.

Le code d'effacement des filtres quand il est exécuté analyse chaque feuille, chaque tableau. Ce qui prend un temps considérable de chargement (une grosse dizaine de secondes).

Je me demande si je peux faire procéder à l'effacement des filtres actifs uniquement sur les feuilles où cela est nécessaire, où si en désignant les tableaux on peut appliquer cette action uniquement sur ces tableaux.

Je ne sais pas si cela est plus clair.

re,

il y a un tableau "TBL_Filtres" dans la feuille "Feuil1" qui contient le noms des feuilles et des tableaux dans ces feuilles que vous voulez traiter.

Sub Filtres()
     Dim t, aA, i, SH As Worksheet, LO As ListObject

     t = Timer
     Application.ScreenUpdating = False

     aA = Range("TBL_Filtres").Value         'lire le contenu (sans entêtes de ce tableau, quelque part dans ce fichier, je ne sais plus la feuille :-)

     For i = 1 To UBound(aA)                 'boucler ces données
          On Error Resume Next
          Set SH = Nothing: Set SH = Worksheets(CStr(aA(i, 1)))
          Set LO = Nothing: Set LO = SH.ListObjects(CStr(aA(i, 2)))
          On Error GoTo 0
          If SH Is Nothing Then
               MsgBox "Feuille """ & aA(i, 1) & """ n'existe pas ", vbCritical
          Else
               If LO Is Nothing Then
                    MsgBox "Tableau """ & aA(i, 2) & """ dans la feuille """ & aA(i, 1) & """ n'existe pas ", vbCritical
               Else
                    LO.Range.AutoFilter
               End If
          End If
     Next

     Application.ScreenUpdating = True
     MsgBox "prêt en " & Format(Timer - t, "0.0\s")

End Sub

Mais l'idée de filtrer plusieurs tableaux dans la même feuille est dangeureux. Si certains tableaux ont horizontallement certaines lignes en commun, vous risquez d'avoir des résultats douteux. En plus, s'il y a plusieurs plages filtrées dans une feuille ce "showalldata" et ces copains ne fonctionnent plus à 100%. Une feuille est destiné pour un filtre à la fois. Je pense même que le filtre du premier tableau se désactive quand vous ajoutez un deuxième filtre manuellement (pas avec VBA) sur un autre tableau (à verifier).

Je vais analyser tout cela.

Merci à vous. Je reviens vous apporter une réponse suite à notre échange.

re, en utilisant 2 fois cet autofilter, les flèches seront cachées et l'autofilter n'est plus là

               If LO Is Nothing Then
                    MsgBox "Tableau """ & aA(i, 2) & """ dans la feuille """ & aA(i, 1) & """ n'existe pas ", vbCritical
               Else
                    LO.Range.AutoFilter 1    'filtrer la prmière colonne = montrer toutes ces valeurs
                    LO.Range.AutoFilter      'désactiver filtre (les flèches seront cachées)
               End If

EDIT : on a même pas besoin de la colonne "Feuille", quand la macro se trouve dans un module ordinair (donc pas dans un module d'une feuille)