Stocker et visualiser des images GIF dans Excel



Image non disponible

Ce document montre comment visualiser une image GIF animée dans Excel et propose une solution pour stocker cette image directement dans le classeur.
Vous pouvez ainsi transférer le classeur sur un autre PC, en ayant toujours l'image GIF disponible dans le fichier Excel.

Testé avec Excel2002 et WinXP.

Article lu   fois.

L'auteur

Site personnel

Liens sociaux

Viadeo Twitter Facebook Share on Google+   

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.

Image non disponible

Sélectionnez l'option "Contrôles supplémentaires".

Image non disponible

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.

Image non disponible

II. Description de la procédure

Le classeur démo contient une interface utilisateur afin de manipuler les fichiers:

Image non disponible



Vous pouvez sélectionner les fichiers gif sur le disque dur en cliquant sur le bouton "Sauvegarder une image GIF dans le classeur".

Image non disponible


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.



Vba
Sélectionnez

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



III. Téléchargement

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants : Viadeo Twitter Facebook Share on Google+   

Ce document est issu de http://www.developpez.com et reste la propriété exclusive de son auteur. La copie, modification et/ou distribution par quelque moyen que ce soit est soumise à l'obtention préalable de l'autorisation de l'auteur.