afficher gif animé pendant execution solveur

Question

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

Utilisateur anonyme · Answer

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

cs_Le Pivert · Answer

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:" & _ "" & LeTexte & "" '---------------------------------------------- '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:" 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

Medorico · Answer

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

cs_Le Pivert · Answer

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

cs_Le Pivert · Answer

il faut comprendre:
Tu rectifieras le code suivant le nom de ta nouvelle feuille 
il faut lire:
SERIEUXETCOOL

Medorico · Answer

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?

Medorico · Answer

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?

cs_Le Pivert · Answer

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

Afficher gif animé pendant execution solveur

8 réponses

Votre réponse

Discussions similaires