I. Introduction▲
La démo téléchargeable en fin de page permet de choisir une image GIF sur le disque dur, de
l'enregistrer dans le classeur au format binaire et ensuite de le visualiser dans un
UserForm.
Il est toujours préférable de stocker les images à l'extérieur d'un fichier afin de ne pas l'alourdir, mais
il s'agit avant tout ici de présenter:
* Le principe de la transformation en binaire.
* L'affichage d'une image GIF animée dans Excel.
* L'utilisation du contrôle
WebBrowser.
L'intérêt de cette solution est de pouvoir transférer ensuite le classeur sur un autre PC, en ayant
l'image GIF jointe directement dans le fichier Excel.
Cette méthode est pratique afin de stocker par exemple un petit logo animé dans vos classeurs.
Le temps de calcul peut toutefois être long (et donc déconseillé) pour les fichiers de taille
volumineuse.
L'exemple est basé sur l'affichage dans un UserForm que vous pourrez aisément adapter dans
la feuille de calcul.
Un WebBrowser (Navigateur Web Microsoft) est utilisé comme support afin de visualiser l'image GIF.
Si le contrôle WebBrowser n'apparaît pas dans la liste des contrôles, faites un clic droit dans
la boite à outils.
Sélectionnez l'option "Contrôles supplémentaires".
Cochez la ligne "Navigateur Web Microsoft".
Cliquez sur OK pour valider.
La procédure enregistre les données binaires du fichier gif dans
les cellules d'une feuille.
Ces données seront ensuite utilisées pour recréer l'image temporairement ("C:\imageTemp.gif")
et la visualiser dans le WebBrowser. L'image temporaire est supprimée lors de la fermeture du
UserForm.
Par soucis d'esthétique, les feuilles contenant les données binaires sont masquées dans le classeur
démo.
Si vous souhaitez voir le contenu des cellules:
* Menu Format
* Feuille
* Afficher
* Sélectionnez une feuille dans la boîte de dialogue.
* Cliquez sur le bouton "OK" pour valider.
II. Description de la procédure▲
Le classeur démo contient une interface utilisateur afin de manipuler les fichiers:
Vous pouvez sélectionner les fichiers gif sur le disque dur en cliquant sur le bouton
"Sauvegarder une image GIF dans le classeur".
Une nouvelle feuille va ensuite être créée pour y enregistrer les données binaires du fichier gif.
Sélectionnez un nom dans le menu déroulant pour visualiser une image dans l'UserForm.
Option Explicit
'Initialisation du UserForm
Private Sub UserForm_Initialize()
Dim x As Byte
'Les données au format binaire, servant à créer les images, sont stockées dans
'des feuilles masquées.
'Chaque feuille correspond à une "image" stockée dans le classeur.
'La macro Remplit le ComboBox en utilisant le nom des feuilles:
'Il suffira ensuite de sélectionner un nom dans la boîte de dialogue afin de
'visualiser l'image correspondante.
'Boucle sur les feuilles (à partir du 2eme onglet):
If ThisWorkbook.Worksheets.Count > 1 Then
For x = 2 To ThisWorkbook.Worksheets.Count
ComboBox1.AddItem ThisWorkbook.Worksheets(x).Name
Next
End If
End Sub
'Bouton "Sauvegarder une image GIF dans le classeur"
'La macro vous permet de sélectionner une image GIF sur votre disque dur et d'en transférer
'le contenu au format binaire, dans les cellules d'une nouvelle feuille de calcul.
'
Private Sub CommandButton1_Click()
Dim Fichier As Variant
Dim i As Long, F As Long, j As Long
Dim b As Byte
Dim Feuille As Worksheet
Dim LeTexte As String
Dim LaCouleur As String
'Affichage de la la boîte de dialogue standard "Ouvrir" pour sélectionner une image GIF
'sur le disque dur.
'GetOpenFilename permet de lire le nom du fichier sélectionné par l'utilisateur sans
'réellement ouvrir le fichier.
Fichier = Application.GetOpenFilename("Fichiers Images (*.gif),*.gif")
'Vérifie si l'utilisateur a cliqué sur le bouton "Annuler" ou sur la croix de fermeture.
If Fichier = False Then
MsgBox "Opération Annulée"
'pour sortir de la procédure
Exit Sub
End If
'Ajoute une feuille dans le claseur et la positionne à la fin.
Set Feuille = ThisWorkbook.Worksheets.Add(After:=Sheets(Sheets.Count))
'Renomme la feuille
Feuille.Name = "Image " & ThisWorkbook.Sheets.Count - 1
'Masque la feuille
Feuille.Visible = xlSheetHidden
i = 1
'----------- 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"
WebBrowser1.Navigate _
"about:<html><body BGCOLOR ='#CCCCCC' scroll='no'><font color= " & LaCouleur & _
" size='5' face='Arial'>" & _
"<marquee>" & LeTexte & "</marquee></font></body></html>"
'----------------------------------------------
'--- transfert des données dans la feuille ----
'Boucle sur les données binaire du fichier sélectionné et les transfert
'dans les cellules de la feuille de calcul.
F = FreeFile
Open Fichier For Binary Access Read As F
While Not EOF(F)
Get #F, , b
DoEvents
j = j + 1
If j = 21 Then
j = 1
i = i + 1
End If
Feuille.Cells(i, j) = b
Wend
Close F
'------------------------------------------------
'Affiche une page blanche dans le webBrowser
WebBrowser1.Navigate "about:blank"
MsgBox "Opération terminée"
'Ferme et réouvre l'UserForm (permet une réinitialisation rapide)
Unload Me
UserForm1.Show
End Sub
'Evenement Change dans le ComboBox;
'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 ComboBox1_Change()
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
'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(ComboBox1.Value).Cells(i, j).Value
Put #F, , b
DoEvents
Loop While ThisWorkbook.Sheets(ComboBox1.Value).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
'Affiche l'image dans le WebBrowser en supprimant les marges et les barres de défilement
WebBrowser1.Navigate _
"ABOUT:<HTML><CENTER><HEAD><body scroll='no' LEFTMARGIN=0 TOPMARGIN=0><IMG WIDTH=" & _
Largeur & " HEIGHT=" & Hauteur & _
" SRC='" & S & "'</IMG></BODY></CENTER></HTML>"
'Version pour afficher l'image à sa taille réelle:
'WebBrowser1.Navigate _
"ABOUT:<HTML><CENTER><HEAD><body scroll='no' LEFTMARGIN=0 TOPMARGIN=0><IMG " & _
" SRC='" & S & "'</IMG></BODY></CENTER></HTML>"
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