XL 2013 Affichage d'un userform avec GIF animé pendant l’exécution d'une macro

Flown720 · 7 Janvier 2020

Bonjour,

Je m'adresse à vous pour vous demander si c'est possible de réaliser une fenêtre avec un gif animé qui sera stocké sur un pc (je n'ai pas besoin de l'integrer au fichier excel)
pour le moment, ça j'ai réussi en faisant une userform avec outil webbrowser , elle s'affiche comme je le souhaite sans que la macro tourne.
Ma macro fonctionne correctement aussi.

Je lance ma macro par un bouton activeX, voici le code que j'utilise

VB:

Private Sub CommandButton1_Click()

ActiveCell.Select
    
UserForm1.Show vbModeless
UserForm1.Repaint
DoEvents

Application.ScreenUpdating = False

'................
'la macro qui tourne comme il faut
'et je termine par ça
'................

Unload UserForm1

End Sub

Après le code de mon userform1 est le suivant

Code:

Private Sub UserForm_Initialize()
Dim S As String
Dim Hauteur As Long, Largeur As Long
Dim LePath As String

LePath = "C:\GIF\"
Largeur = WebBrowser1.Width * 140 / 110
Hauteur = WebBrowser1.Height * 441 / 410

S = LePath & "loading-spin-defaut.gif"

WebBrowser1.Navigate _
"ABOUT:<HTML><CENTER><HEAD><body scroll='no' LEFTMARGIN=0 TOPMARGIN=0><IMG WIDTH=" & _
Largeur & " HEIGHT=" & Hauteur & _
" SRC='" & S & "'</IMG></BODY></CENTER></HTML>"

End Sub

Donc mon problème, c'est que pratiquement tout fonctionne, alors que j'ai récuperer pas mal de code sur le forum pour l'adapter.
Le seul soucis, c'est que le gif ne s'anime pas, mais il s'affiche dans l'userform, et s'arrête bien au bon moment.

Alors c'est mon premier post sur ce type, j'espère avoir été le plus clair possible de mes attentes, et j'espère avoir des solutions à problèmes
Merci encore

patricktoulon · 10 Janvier 2020

re oui le msgbox excel c'est pour te montrer qu'il s'execute meme si le msgbox hta est affiché donc la macro continue
pour le temps oui si tu veux
mais on regardera ce weekend pour faire communiquer ta macro au document hta pour lui dire de s’arrêter

Flown720 · 10 Janvier 2020

ET j'ai pas eu le temps de regarder du côté de evaluate... je vais prendre un peu de temps pour chercher.
Merci encore de ta précieuse aide

patricktoulon · 11 Janvier 2020

re
virage 190°

et oui parce que des idées j'en ai plein
avec IE(internet explorer on peut faire la même chose
en utilisant une variable("OBJRETURN") en CALLBACK je ferme la fenêtre quand je veux et dans la sub lanceuse

voila
l'ouverture et fermeture est maitriser dans la sub

VB:

Sub testavecIE()
    Dim Gif$, t&, OBJRETURN As Object
    Gif = "C:\Users\polux\DeskTop\cuicui.gif"    'mettre l'adresse du gif ici
    'on lance le message
    msgboxhtml "il est pas dans excel mon message ", "MESSAGE HORS EXCEL BY patricktoulon", Gif, OBJRETURN

    'POUR TESTER exemple on attend un peu
    t = Timer
    Do:: DoEvents: Loop While Timer - t < 5 '5secondes

    'apres ces 5 secondes on ferme le message
    OBJRETURN.Quit
End Sub


Function msgboxhtml(Message, titre, Gif, obj As Object) As Object

    Dim oIE As Object

    Set obj = CreateObject("InternetExplorer.Application")
    With obj
        .Top = 100
        .Left = 100
        .AddressBar = False
        .MenuBar = False
        .StatusBar = False
        .Toolbar = False
        .Visible = True
        .Width = 280
        .Height = 330
        .navigate2 "about:blank"

        Do While .readyState <> 4: DoEvents: Loop    'attend la fin du chargement
        code = "<html>|<head>| <title>|" & titre & "|</title>| </head>|<body style=""margin:0;"">|<p align=""center""> " & Message & _
               "</p>|<img style=""width:100%;height:150;"" src=""" & Gif & """></img>|</body>|</html>"

        code = Replace(code, "|", vbCrLf)
        .document.write code

    End With

End Function

pourquoi je n'y ai pas pensé plus tôt

ET C'EST NON BLOQUANT

Flown720 · 11 Janvier 2020

je viens de tester ce nouveau codage, et je suis malheureusement obligé de t'annoncé que ça fonctionne pas chez moi
alors je me demande toujours si j'ai pas foiré qqchose....
En tout cas, j'ai bien le message qui s'affiche, mais je sais que ma macro de test s’exécute en 13sec. sauf qu'avec ce message elle met 23sec
la différence est bien les 10sec d'affichage du message (je l'ai augmenté pour accentué le défaut)

eriiic · 11 Janvier 2020

Bonjour,

Pour faire accélérer ta macro il faut travailler en mémoire.
Le principe est de lire les données en une fois dans une variable tableau, travailler avec ce tableau et coller le résultat en une fois.
Le gain peut être de x100...
eric

Flown720 · 11 Janvier 2020

eriiiic à dit:
Bonjour,

Pour faire accélérer ta macro il faut travailler en mémoire.
Le principe est de lire les données en une fois dans une variable tableau, travailler avec ce tableau et coller le résultat en une fois.
Le gain peut être de x100...
eric

Alors j’ai aucun doute que ce que j’ai fait peut-être largement amélioré. Par contre, ce que tu m’as décrit je sais pas comment le faire. Car j’ai déjà une mise en forme tableau dans Excel, et quand j’écris dans la colonne j’écris bien tous d’un coup dans cette colonne avec ce code là

VB:

Range("Données[Statut]").FormulaR1C1 = _
    "=IF([@[Type d''erreur]]<>"""",""1 - ERREUR"",IF([@[Montant total]]=0,""4 - NE PAS ENVOYER"",""2 - PRÊT A ENVOYER""))"
Range("Données[Statut]") = Range("Données[Statut]").Value

Est-ce que tu pourrai plus m’en dire, s’il te plaît ?

eriiic · 11 Janvier 2020

Effectivement, tu écris en une fois. Pas sûr d'avoir un gain important (voire même une perte), il faut tester pour avoir la réponse.
As-tu désactivé les maj en début de macro ? Avec :

VB:

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

à rétablir avec :

Code:

Application.Calculation = xlCalculationAutomatic

Ca peut faire un gain conséquent.

Sinon je te met un exemple de travail en mémoire que tu aies le principe.
Je n'utilise pas le fait que tu aies déclaré tes données en tableau ce qui ne simplifierait pas le code, et sa compréhension.
Une plage en tableau c'est autre chose que de travailler avec des tableaux en VBA, c'est indépendant.
eric

patricktoulon · 11 Janvier 2020

Bonjour le fil
oui tu a du rater quelque chose (au pire 1 seconde de plus pour ouvrir IE et c'est tout)

il est certain que des que ie est ouvert ou meme le hta dans l'autre version il n'a plus rien a voir avec l'exécution du code de la macro

serait ce les allocations mémoire qui ne se libère pas ??

VB:

Sub testavecIE()
    Dim Gif$, t&, OBJRETURN As Object
    Gif = "C:\Users\polux\DeskTop\cuicui.gif"    'mettre l'adresse du gif ici
    'on lance le message
    msgboxhtml "il est pas dans excel mon message ", "MESSAGE HORS EXCEL BY patricktoulon", Gif, OBJRETURN
    
    'POUR TESTER va remplir des cellule pendant l'affichage du msgbox html
    t = Timer
    Do:: DoEvents
    i = i + 1
    Cells(i, 1) = "Flown" & 720 + i
    Loop While Timer - t < 5 '5secondes

    'maintenant on ferme le message
    OBJRETURN.Quit
End Sub


Function msgboxhtml(Message, titre, Gif, obj As Object) As Object

    Dim objie As Object

    Set objie = CreateObject("InternetExplorer.Application")
    With objie
        .Top = 100
        .Left = 100
        .AddressBar = False
        .MenuBar = False
        .StatusBar = False
        .Toolbar = False
        .Visible = True
        .Width = 280
        .Height = 330
        .navigate2 "about:blank"

        Do While .readyState <> 4: DoEvents: Loop    'attend la fin du chargement
        code = "<html>|<head>| <title>|" & titre & "|</title>| </head>|<body style=""margin:0;"">|<p align=""center""> " & Message & _
               "</p>|<img style=""width:100%;height:150;"" src=""" & Gif & """></img>|</body>|</html>"

        code = Replace(code, "|", vbCrLf)
        .document.write code

    End With
Set obj = objie
Set objie = Nothing
End Function

si ta colonne "A" se rempli pendant l'affichage c'est que ca marche

Flown720 · 11 Janvier 2020

eriiiic à dit:
Effectivement, tu écris en une fois. Pas sûr d'avoir un gain important (voire même une perte), il faut tester pour avoir la réponse.
As-tu désactivé les maj en début de macro ? Avec :

VB:

Application.Calculation = xlCalculationManual Application.ScreenUpdating = False

à rétablir avec :

Code:

Application.Calculation = xlCalculationAutomatic

Ca peut faire un gain conséquent.

Sinon je te met un exemple de travail en mémoire que tu aies le principe.
Je n'utilise pas le fait que tu aies déclaré tes données en tableau ce qui ne simplifierait pas le code, et sa compréhension.
Une plage en tableau c'est autre chose que de travailler avec des tableaux en VBA, c'est indépendant.
eric

Alors, j'ai pas compris va falloir, que je le regarde de plus près, mais il est certain que ça va vite, à méditer de mon côté!!!!
Et là, je lance un test sur la macro avec le le code

VB:

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

à rétablir avec :

Code:

Application.Calculation = xlCalculationAutomatic

En tout cas merci de votre aide

Flown720 · 11 Janvier 2020

patricktoulon à dit:

Bonjour le fil
oui tu a du rater quelque chose (au pire 1 seconde de plus pour ouvrir IE et c'est tout)

il est certain que des que ie est ouvert ou meme le hta dans l'autre version il n'a plus rien a voir avec l'exécution du code de la macro

serait ce les allocations mémoire qui ne se libère pas ??

VB:

Sub testavecIE()
    Dim Gif$, t&, OBJRETURN As Object
    Gif = "C:\Users\polux\DeskTop\cuicui.gif"    'mettre l'adresse du gif ici
    'on lance le message
    msgboxhtml "il est pas dans excel mon message ", "MESSAGE HORS EXCEL BY patricktoulon", Gif, OBJRETURN
   
    'POUR TESTER va remplir des cellule pendant l'affichage du msgbox html
    t = Timer
    Do:: DoEvents
    i = i + 1
    Cells(i, 1) = "Flown" & 720 + i
    Loop While Timer - t < 5 '5secondes

    'maintenant on ferme le message
    OBJRETURN.Quit
End Sub


Function msgboxhtml(Message, titre, Gif, obj As Object) As Object

    Dim objie As Object

    Set objie = CreateObject("InternetExplorer.Application")
    With objie
        .Top = 100
        .Left = 100
        .AddressBar = False
        .MenuBar = False
        .StatusBar = False
        .Toolbar = False
        .Visible = True
        .Width = 280
        .Height = 330
        .navigate2 "about:blank"

        Do While .readyState <> 4: DoEvents: Loop    'attend la fin du chargement
        code = "<html>|<head>| <title>|" & titre & "|</title>| </head>|<body style=""margin:0;"">|<p align=""center""> " & Message & _
               "</p>|<img style=""width:100%;height:150;"" src=""" & Gif & """></img>|</body>|</html>"

        code = Replace(code, "|", vbCrLf)
        .document.write code

    End With
Set obj = objie
Set objie = Nothing
End Function

si ta colonne "A" se rempli pendant l'affichage c'est que ca marche

Avec ce code là, ça rempli la colonne A pendant l'affichage, la seule chose que je vois c'est qu'elle ne termine pas à toujours à la même ligne

patricktoulon · 12 Janvier 2020

bonsoir
ben elle termine pas toujours a la même ligne tout simplement par ce que ton pc n'a pas constamment la même occupation de mémoire et procc donc des fois il va plus vite des fois moins vite donc en 5 secondes il peut avoir un résultat plus ou moins différent a chaque essai c'est normal
donc celui la fonctionne aussi puisque tu a les cellules d'inscrites

tu a le choix de la méthode maintenant

Flown720 · 12 Janvier 2020

Salut à tous,
je crois que la nuit porte conseil, et j'ai pas eu le temps ce matin de tester, mais je crois que j'ai compris mon erreur...
il faut que je refasse mes petits essais, mais je sens que c'est sur la bonne voie...

patricktoulon · 12 Janvier 2020

re
bonjour @Flown720
c'est pas compliqué tu remplace
ceci et rien que ceci

VB:

'POUR TESTER va remplir des cellule pendant l'affichage du msgbox html
    t = Timer
    Do:: DoEvents
    i = i + 1
    Cells(i, 1) = "Flown" & 720 + i
    Loop While Timer - t < 5 '5secondes

par ton code qui dure
ET C EST TOUT

Flown720 · 13 Janvier 2020

Bonjour,

Alors, je vais m'absenter un petit moment, et j'ai pas eu le temps de tester ce week-end !!

donc à bientot

Flown720 · 18 Janvier 2020

Bonjour,

Je suis de retour après mon opération, pas évidement pour moi, mais j'ai tester un peu mieux. donc le dernier code fonctionne à merveille !!!! c'est juste moi qui encore une fois avait pas bien compris comment l'employer !!

Merci encore

XL 2013 Affichage d'un userform avec GIF animé pendant l’exécution d'une macro

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Nouveau

Discussions similaires

Partager cette page

Statistiques des forums