Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Flown720

XLDnaute Nouveau
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
 
Solution
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...
Trier par date Trier par votes

patricktoulon

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
Solution

Flown720

XLDnaute Nouveau
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)
 
Vote positif 0 Vote négatif

eriiic

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif

Flown720

XLDnaute Nouveau
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 ?
 
Vote positif 0 Vote négatif

eriiic

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

Pièces jointes

  • Classeur1.xlsm
    18.1 KB · Affichages: 15
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
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
 
Dernière édition:
Vote positif 0 Vote négatif

Flown720

XLDnaute Nouveau

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
 
Vote positif 0 Vote négatif

Flown720

XLDnaute Nouveau


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
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif

Flown720

XLDnaute Nouveau
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...
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif

Flown720

XLDnaute Nouveau
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
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

L
  • Question
Microsoft 365 Macro Insertion image dans cellule
Réponses
3
Affichages
786
Dranreb
F
  • Question
Microsoft 365 UserForm maximiser la taille du formulaire par rapport à la taille de l'écran
2
Réponses
22
Affichages
2 K
TooFatBoy
  • Question
Microsoft 365 UserForm zoom affichage
Réponses
7
Affichages
863
ChTi160
  • Question
XL 2013 VBA Insérer image dans zone sélectionnée
Réponses
11
Affichages
1 K
patricktoulon
  • Question
XL 2016 Calculer la position sur l'écran d'une position sur la grille (XL 2003)
2
Réponses
27
Affichages
3 K
Nicolas JACQUIN
T
  • Résolu(e)
XL 2019 Incorporer gif animé dans userform
Réponses
6
Affichages
3 K
Tempus
T
C
  • Question
Microsoft 365 VBA Moyennes avec conditions
Réponses
7
Affichages
592
AtTheOne
S
  • Question
XL 2016 Modification d'une Macro d'envoi d'email
Réponses
2
Affichages
842
Sylvain29
S
  • Question
XL 2019 Problème avec WorksheetFunction
Réponses
2
Affichages
989
cp4
B
  • Question
XL 2010 Alimenter une valeur issue d'une base de donnée dans une textbox crée dynamiquement avec variable
Réponses
6
Affichages
1 K
Bob O' Deville
B
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…