Afficher gif animé pendant execution solveur

Signaler
Messages postés
16
Date d'inscription
lundi 2 janvier 2012
Statut
Membre
Dernière intervention
5 mai 2012
-
Messages postés
7203
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
17 janvier 2021
-
Salut à tous,

Je recherche un coup de pouce pour animer un gif pendant l'exécution de mon solveur!

j'affiche un userform contenant un gif animé pendant l'exécution de mon solveur, seulement mon gif ne s'anime pas pendant. J'aurais pu le faire si j'avais une boucle mais là je bloque! j'ai essayé avec un DoEvents mais rien n'y fait mon gif reste statique! quelqu'un aurait une idée?

Medorico

Application.Cursor = xlWait 'affiche le sablier
WaitBox.Show vbModeless 'affiche la waitbox mais continu le traitement
WaitBox.Repaint  

SolverReset
SolverOk SetCell:=Range("M2"), MaxMinVal:=1, ByChange:=Range("I3", Range("J3").End(xlDown))
'Solveradd cellref:=Range("M3"), Relation:=2, FormulaText:=0
Solveradd cellref:=Range("M4"), Relation:=1, Formulatext:=Range("N4")
Solveradd cellref:=Range("I3", Range("J3").End(xlDown)), Relation:=1, Formulatext:=10
SolverSolve userfinish:=True

DoEvents

WaitBox.Hide 'masque la waitbox
Application.Cursor = xlDefault 'remet le curseur par défaut
A voir également:

8 réponses


Bonjour,

Une vieille affaire de ma composition.

Je ne me souviens pas si j'avais ajouté GIF89.dll

Elle devrait être encore disponible à quelque part
Messages postés
7203
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
17 janvier 2021
118
Bonjour,
J'ai répondu il y a quelques mois à cette question:

http://www.vbfrance.com/forum/sujet-CREATION-USERFORM-ANNIME-FAIRE-PATIENTER-UTILISATEUR_1544759.aspx?p=2

Tu ajoutes 2 WebBrowser dans ton UserForm:
Voici le code

Option Explicit
Private Sub UserForm_Initialize()

    Dim x As Byte

    'If ThisWorkbook.Worksheets.Count > 1 Then 'Boucle sur les feuilles (à partir du 2eme onglet):
       ' For x = 2 To ThisWorkbook.Worksheets.Count
           ' ComboBox1.AddItem ThisWorkbook.Worksheets(x).Name
       ' Next
   ' End If
   
    
    Dim LeTexte As String, LaCouleur As String
    
    '----------- message pendant le transfert ----
    'Permet de créer un message d'attente défilant dans le WebBrowser pendant le transfert
    'des données (au format binaire) dans les cellules de la nouvelle feuille.
    LeTexte = "Veuillez patienter... traitement en cours ..."
    LaCouleur = "#CC0000"
    
    WebBrowser2.Navigate _
    "about:<html>" & _
    "<marquee>" & LeTexte & "</marquee></html>"
    '----------------------------------------------
   'Afficherimage 'activer quand il y aura une image
End Sub
'La sélection d'un nom va déclencher la création d'un fichier gif à partir des données
'binaires stockées dans la feuille, puis l'affichage de cette image dans le WebBrowser.
Private Sub Afficherimage()
    Dim S As String
    Dim i As Long, F As Long
    Dim j As Byte, b As Byte
    Dim Hauteur As Long, Largeur As Long
    Sheets("IMAGE").Select
'    'Vérifie qu'il y a bien un nom de choisi dans le ComboBox.
'    If ComboBox1.Value = "" Then Exit Sub
    
    i = 1
    'Définit le chemin de l'image qui va être créée.
    S = "C:\imageTemp.gif"
    
    '----- Création de l'image pour un affichage dans l'USF -----
    F = FreeFile
    Open S For Binary Access Write As F
    
        Do
        j = j + 1
                If j = 21 Then
                j = 1
                i = i + 1
                End If
        b = ThisWorkbook.Sheets("IMAGE").Cells(i, j).Value
        Put #F, , b
        DoEvents
        Loop While ThisWorkbook.Sheets("IMAGE").Cells(i, j).Value <> ""
    
    Close F
    '------------------------------------------------------------
    
'        'Définit les dimensions d'affichage de l'image dans le WebBrowser.
'    Largeur = WebBrowser1.Width * 96 / 72
'    Hauteur = WebBrowser1.Height * 96 / 72
    
   ' Version pour afficher l'image à sa taille réelle:
    WebBrowser1.Navigate _
    "ABOUT:<HTML><CENTER><HEAD></CENTER></HTML>"
          Sheets("Feuil1").Select
End Sub
'Evênement fermeture du UserForm
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Dim Fs As Object
    
    Set Fs = CreateObject("Scripting.FileSystemObject")
    'Supprime l'image temporaire si elle existe
    If Fs.FileExists("C:\imageTemp.gif") Then Kill "C:\imageTemp.gif"
End Sub



@+Le Pivert
Messages postés
16
Date d'inscription
lundi 2 janvier 2012
Statut
Membre
Dernière intervention
5 mai 2012

Salut et merci pour vos réponses!
j'ai essayé de mettre en place la solution de pivert mais le programme m'indique une erreur d'accès chemin/fichier à ce moment " Open S For Binary Access Write As F ". Vous voyez le problème?

Medorico
Messages postés
7203
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
17 janvier 2021
118
Telecharge le classeur sur ce site:

http://silkyroad.developpez.com/VBA/ExcelImageGIF/
ensuite quand tu as crée ton image en données binaire sur une feuille tu copies ta feuille dans ton classeur.

Tu renommeras ta feuille suivant le nouveau nom:
b = ThisWorkbook.Sheets("IMAGE").Cells(i, j).Value
Put #F, , b
DoEvents
Loop While ThisWorkbook.Sheets("IMAGE").Cells(i, j).Value

Tout est expliqué sur le post que je t'ai indiqué. Pour plus d'info vois SERIEUXCOOL
Le Pivert
Messages postés
7203
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
17 janvier 2021
118
il faut comprendre:
Tu rectifieras le code suivant le nom de ta nouvelle feuille
il faut lire:
SERIEUXETCOOL
Messages postés
16
Date d'inscription
lundi 2 janvier 2012
Statut
Membre
Dernière intervention
5 mai 2012

J'avais en effet déjà trouvé ce classeur pour générer une feuille avec les données binaires mais même avec ce classeur je n'arrive pas à visualiser le gif. Peut-être y-a-t-il un contrôle à télécharger que je n'ai pas ou simplement à l'activer?
Quelqu'un aurait une idée?
Messages postés
16
Date d'inscription
lundi 2 janvier 2012
Statut
Membre
Dernière intervention
5 mai 2012

Le programme m'indique une erreur d'accès chemin/fichier à ce moment " Open S For Binary Access Write As F ". Quelqu'un aurait une idée du problème?
Messages postés
7203
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
17 janvier 2021
118
Je t'envoie un exemple que j'ai fait. Il suffit de le télécharger sur ce lien

http://cjoint.com/?BEgh3mvfXY0

Tu comprendras mieux en voyant ce classeur. Fait sous Excel 2003
@+Le Pivert