Enregistrer un graphique en .gif Résolu

Question

Bonjour, 

J'ai trouvé ce code sur le net :

Sub ENREGISTRER()

'Supprime l'image temportaire si elle existe
   If Dir(Fichier) <> "" Then Kill Fichier
 
    'Définit le 1er graphique de la Feuil1
    'exporte le graphique au format image
    Sheets(1).ChartObjects(1).Chart.Export Filename:=Fichier, filtername:="GIF"

End Sub

Cependant Excel me dit : "Application.Column... = <La méthode "Columns" de l'objet Application a échoué.

Ca veut dire quoi exactement svp?

Merci d'avance.

Cordialement.

cs_Le Pivert · Answer

Bonjour,

Voir ceci:

http://jacxl.free.fr/cours_xl/cours_xl_jac.html#xl_en_gif

cs_Le Pivert · Answer

Regarde les 2 méthodes de "parmi":

 https://www.developpez.net/forums/d1362416/logiciels/microsoft-office/excel/macros-vba-excel/boite-dialogue-enregistrer-sous-nom-fichier/

cs_Le Pivert · Answer

Je ne comprend rien. Tu veux enregistrer le graph en gif ou le classeur? 

si c'est le graph tu te sers des liens que je t'ai donné pour avoir le chemin et l'adapter a la macro.

si c'est le classeur, tu te sers de l'enregistreur de macro

pijaku · Answer

Bonjour Kuartz, Le Pivert,

Et si tu nous disais ce que tu veux faire exactement!
Enregistrer le graphique? le fichier? la feuille? Une image?

pijaku · Answer

Bonjour,

Excuse le délai de réponse, mais Internet merde grave ici...

Bon, dessine un contrôle Image (nommé Image1) sur ton Userform, un bouton de commande (nommé CommandButton1) et voici le code (emprunté à Mr PIERRON) :

Option Explicit

Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(7) As Byte
End Type

Private Type UPICDESC
   Size As Long
   Type As Long
   hPic As Long
   hPal As Long
End Type

Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32" (ByRef pPicDesc As UPICDESC, ByRef RefIID As GUID, ByVal fOwn As Long, ByRef IPic As IPicture) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub CommandButton1_Click()
Dim BmpFile As String
   
   OpenClipboard 0: EmptyClipboard: CloseClipboard
   With ActiveSheet.Shapes("Graphique 1")
      .Copy
   End With
   DoEvents
   Sleep 200
   SaveBmp BmpFile
   Image1.Picture = LoadPicture(BmpFile)
   Kill BmpFile
End Sub

Public Sub SaveBmp(BmpFile As String) 'Michel PIERRON
On Error GoTo Fin
Dim oPic As IPictureDisp
'http://www.generation-nt.com/reponses/graphique-feuille-excel-userform-entraide-89373.html#353430
   BmpFile = ThisWorkbook.Path & "\Temp.bmp"
   Set oPic = PasteBmp: SavePicture oPic, BmpFile
   Set oPic = Nothing: Exit Sub
Fin:    MsgBox "Image non trouvée !", 48
End Sub

Public Function PasteBmp() As IPicture 'Michel PIERRON
Dim hCopy As Long
'http://www.generation-nt.com/reponses/graphique-feuille-excel-userform-entraide-89373.html#353430
   If IsClipboardFormatAvailable(2) Then
      If OpenClipboard(0&) Then
      hCopy = CopyImage(GetClipboardData(2), 0, 0, 0, &H4)
      CloseClipboard
      If hCopy Then Set PasteBmp = CreateBmp(hCopy, 0, 2)
      End If
   End If
End Function

Public Function CreateBmp(ByVal hPic As Long, ByVal hPal As Long, ByVal lPicType) As IPicture 'Michel PIERRON
Dim i As Long, PicInfo As UPICDESC, OlePicStore As GUID, IPic As IPicture
'http://www.generation-nt.com/reponses/graphique-feuille-excel-userform-entraide-89373.html#353430
   With OlePicStore
      .Data1 = &H7BF80980: .Data2 = &HBF32: .Data3 = &H101A
      For i = 1 To 8
         .Data4(i - 1) = Choose(i, &H8B, &HBB, &H0, &HAA, &H0, &H30, &HC, &HAB)
      Next i
   End With
   With PicInfo
      .Size = Len(PicInfo)
      .Type = 1
      .hPic = hPic
      .hPal = hPal
   End With
   If OleCreatePictureIndirect(PicInfo, OlePicStore, True, IPic) Then MsgBox "Impossible de créer le bitmap !", 48
   Set CreateBmp = IPic
End Function

Tu vois, c'était simple ;-)

Un fichier exemple

cs_Le Pivert · Answer

Salut pijaku,

encore plus simple:

 Dim Chemin As String
 Chemin = ThisWorkbook.Path & "\mongraph.gif"
  Sheets("Feuil1").ChartObjects("Graphique 2").Chart.Export Chemin, "GIF"
   Image1.Picture = LoadPicture(Chemin)
   Kill Chemin

Enregistrer un graphique en .gif

6 réponses

Newsletters