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

patricktoulon · 7 Janvier 2020

re
bonsoir
rien compris a ta question
un gif qui n'est pas animé dans un webbrowser ??????
tu veux faire quoi exactement

afficher ton animation pendant la macro ?

ben met un doevents dans ta boucle qui tourne
fait un show 0 sur ton userform au début de la macro
un unload a la fin

Flown720 · 7 Janvier 2020

Zut je pensai avoir été clair
Alors, oui je veux que le gif animé de mon userform reste animé pendant que la macro s’exécute en arrière plan.
dans mon mon code, j’ai mis «UserForm1.Show vbModeless » c’est bien la même chose que show 0, non ?
Le doevents je l’ai mis aussi par contre ma macro ne possède pas de boucle, ça pose un problème pour rafraîchir l’affichage ?
Et pour ce qui est du unload à la fin, il est mis et ça fonctionne.

patricktoulon · 7 Janvier 2020

si il n'y a pas de boucle et qu'elle dure je me demande bien qu'est ce qu'elle fait ca doit être trop lourd

Flown720 · 7 Janvier 2020

Oui la macro est vraiment lourde... j’ai essayé de la faire la plus simple, avant j’avais une boucle, mais c’était encore beaucoup plus long.... Donc au vue de votre réponse, il faut une boucle pour que ça s’anime ?

patricktoulon · 7 Janvier 2020

non il faut pas une boucle !! je dis que si il y avais eu une boucle un doevents aurais permis le rafraichissement de l'userform
la en l'occurence il faut utiliser un autre stratagème
qui est de lancer un script en lancant un HTA qui est externe a excel et tuer le proccessus mshta.exe a la fin
j'ai certainement ca dans mes archives je l'ai utiliser longtemps pour faire des msgbox non bloquants

pour info
hta=html application

Flown720 · 7 Janvier 2020

Merci d’avoir traduit hta parce que j’avais pas compris... je suis vraiment novice dans tout ça...

patricktoulon · 8 Janvier 2020

re
bon @Eric C m'a laisser sous entendre dans un message privé , que je me mettais pas a la portée d'un debutant

alors j'explique ( je précise que cette méthode c'est pas moi qui l'ai inventé)

le principe
normalement un fichier "blablabla.html" meme local on l'ouvre avec notre explorateur préféré(internet explorer,chrome,firefox,etc.... pour les plus courant

mais un fichier html si on lui change l'extention en " .hta" va s'ouvrir avec mshta.exe
c'est une application que tout les windows ont

c'est une simple fenetre qui t'affiche le document ".hta" comme si c'etait dans l'explorateur
sauf qu'il n'y a pas de menu etc...

parti de la le principe est de coder le code html dans une macro et de creer un fichier .hta

il ne reste plus qu'a exécuter le hta par l’intermédiaire de wscript.shell.run nomdufichier
et de le killer (supprimer) des qu'il est lancé

une demo parle bien mieux que des mots
voici un exemple de msgbox temporaire creer avec un hta dans le quel il y a un gif animé
vellez a mettre le bon chemin du gif

ici le message s'affiche 3 secondes (3000)

VB:

Option Explicit
Sub test()
    Dim Gif$, T&
    Gif = "C:\Users\polux\DeskTop\cuicui.gif"    'mettre l'adresse du gif ici!!!!!!!!!
    T = 3000    'durrée d'affichage di message
    msgboxHTA "il est pas dans excel mon message ", 3000, "patricktoulon", Gif
End Sub

Function msgboxHTA(Message, durée, titre, Gif)
    Dim code$, fichier, X&
    code = "<html>|<HTA:APPLICATION SysMenu=""no"" Scroll=""no"" Border=""dialog"">|" & _
           "<head>| <title>|" & titre & "|</title>| <script language = ""VBScript"">|" & _
           "Sub Window_OnLoad|window.moveTo 550,280|window.resizeTo 250, 330|" & _
           "idTimer = window.setTimeout(""Stopmessage""," & durée & ", ""VBScript"")|End Sub|" & _
           "Sub Stopmessage|window.close|End Sub|" & _
           "</script>|</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)

    fichier = Environ("userprofile") & "\Desktop\test.hta"
    X = FreeFile: Open fichier For Output As #X: Print #X, code: Close #X

    With CreateObject("Wscript.Shell"): .Run fichier, 1, True: End With
    Kill fichier
    'Debug.Print code
End Function

voila

Flown720 · 8 Janvier 2020

Woawwww c'est génial !!!! c'est vraiment excellent, j'osai pas venir poser ma question, mais au final il y a bien toujours une solution à tout !!! un grand merci.
par contre, j'ai un petit soucis, c'est que ça met en pause ma macro durant le temps d'affichage de la fenetre msgHTA ? il faut lui rajouter un code pour du genre "non nodal" pour qu'elle puisse s'afficher sans suspendre la macro derrière?

patricktoulon · 8 Janvier 2020

bonsoir
re alors tu a un autre problème car justement elle est sensée etre non bloquante puisque externe a excel
je suis curieux de voir cette macro

essaie celui la peut etre qu'en liberant le wscript.shell ca va le faire

VB:

Option Explicit
Sub test()
    Dim Gif$, T&
    Gif = "C:\Users\polux\DeskTop\cuicui.gif"    'mettre l'adresse du gif ici
    T = 3000    'durrée d'affichage di message
    msgboxHTA "il est pas dans excel mon message ", 3000, "patricktoulon", Gif
End Sub
Function msgboxHTA(Message, durée, titre, Gif)
    Dim code$, fichier, X&, WsH As Object
    code = "<html>|<HTA:APPLICATION SysMenu=""no"" Scroll=""no"" Border=""dialog"">|" & _
           "<head>| <title>|" & titre & "|</title>| <script language = ""VBScript"">|" & _
           "Sub Window_OnLoad|window.moveTo 550,280|window.resizeTo 250, 330|" & _
           "idTimer = window.setTimeout(""Stopmessage""," & durée & ", ""VBScript"")|End Sub|" & _
           "Sub Stopmessage|window.close|End Sub|" & _
           "</script>|</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)

    fichier = Environ("userprofile") & "\Desktop\test.hta"
    X = FreeFile: Open fichier For Output As #X: Print #X, code: Close #X
    Set WsH = CreateObject("Wscript.Shell")
    WsH.Run fichier, 1, True: Set WsH = Nothing
    Kill fichier
    'Debug.Print code
End Function

Flown720 · 8 Janvier 2020

Là je viens de tester avec ce nouveau code.
Et je vois pas de différence, j'ai toujours le même fichier de test, pour ne pas passer mon temps à attendre qu'elle s’exécute, j'ai raccourci les données à traiter, donc là, elle met dans les 10sec.

Et quand je rallonge le temps le temps d'affichage de la msgboxHTA, ça rallonge le temps total...

Flown720 · 10 Janvier 2020

J'ai essayé de regarder quel autre paramètre, il faudrait modifié pour qu'elle soit pas bloquante, mais j'y suis pas arrivé

Par contre, je peux certainement améliorer la macro.
La macro consiste à mettre à jour plusieurs colonnes pour créer un "statut" d'une ligne.
Les lignes sont environ au nombre 3000 et le tableau est sous une mise en forme de tableau.

et la macro rempli, une formule dans ce type (exemple : pour une colonne)

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

Je pense que c'est dans cette formule que je pourrais gagner du temps.
Peut-etre créer une boucle mais quand j'avais essayé c'était encore plus long, j'avais pas du la créer de la meilleur façon.

Et aussi comment je doit coder pour prendre directement la valeur de la formule?

patricktoulon · 10 Janvier 2020

re

Et aussi comment je doit coder pour prendre directement la valeur de la formule?

cherche du coté de evaluate

patricktoulon · 10 Janvier 2020

bon apres quelques test sur 2013 et 2016 sur portable il semblerait que le wscript.shell ne libere pas sur ses versions
conclusion utilise shell la vba est libéré pendant l'affichage du message

VB:

Option Explicit
Sub test()
    Dim Gif$, T&
    Gif = "C:\Users\polux\DeskTop\cuicui.gif"    'mettre l'adresse du gif ici
    T = 3000    'durrée d'affichage di message
    msgboxHTA "il est pas dans excel mon message ", 10000, "patricktoulon", Gif
MsgBox "coucou la oui!!!   :) je suis dans excel "
End Sub
Sub msgboxHTA(Message, durée, titre, Gif)
    Dim code$, fichier, X&
    code = "<html>|<HTA:APPLICATION SysMenu=""no"" Scroll=""no"" Border=""dialog"">|" & _
           "<head>| <title>|" & titre & "|</title>| <script language = ""VBScript"">|" & _
           "Sub Window_OnLoad|window.moveTo 550,280|window.resizeTo 250, 330|" & _
           "idTimer = window.setTimeout(""Stopmessage""," & durée & ", ""VBScript"")|End Sub|" & _
           "Sub Stopmessage|window.close|End Sub|" & _
           "</script>|</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)

    fichier = Environ("userprofile") & "\Desktop\test.hta"
    X = FreeFile: Open fichier For Output As #X: Print #X, code: Close #X

    'With CreateObject("Wscript.Shell"): .Run fichier, 1, True: End With
   Shell "C:\Windows\System32\mshta.exe " & fichier, 1
 Kill fichier
    ThisWorkbook.Activate
    'Debug.Print code

End Sub

Flown720 · 10 Janvier 2020

Bonsoir,
Si je laisse la ligne

VB:

MsgBox "coucou la oui!!!   :) je suis dans excel "

ça bloque encore la macro, je sais pas pourquoi par contre, quand je la retire, ça fonctionne, nickel

Par contre, on peux fermer l'affichage à la fin de la macro automatiquement?

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

Flown720

XLDnaute Nouveau

patricktoulon

patricktoulon

XLDnaute Barbatruc

Flown720

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Flown720

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Flown720

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Flown720

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Flown720

XLDnaute Nouveau

Flown720

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Flown720

XLDnaute Nouveau

Discussions similaires