Enregistrer un graphique en .gif

Résolu
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   -  
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   -
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.

6 réponses

Réponse 1 / 6
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
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
1
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Salut,

En effet.
Mais pourquoi faire simple quand...
A+
0
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
c'était l'exemple du lien que j'avais donné en premier!
ci-dessous
0
Réponse 2 / 6
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
Bonjour,

Voir ceci:

http://jacxl.free.fr/cours_xl/cours_xl_jac.html#xl_en_gif


0
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   61
 
Bonjour

Merci pour l'info, mais ma demande vient de changer (pardon...)

J'ai trouvé le code suivant : 

Sub Enreg_Pdf()
Dim LaDate As String, LeParcours As String, LeRep As String
LaDate = Format(Date, "yyyymmdd")
LeParcours = Range("N2").Value
LeRep = ThisWorkbook.Path & "\parcours\"  ' à adapter
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    LeRep & LaDate & "_" & LeParcours & ".pdf", Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False
End Sub


Qui m'irait parfaitement. Mais comment je peux faire pour ne pas avoir un chemin déjà établi pour l'export en pdf mais pour qu'excel me demande où je veux l'enregistrer et sous quel nom?

Merci d'avance.

Cordialement.
0
Réponse 3 / 6
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
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/
0
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   61
 
Merci,

Par contre, je n'arrive pas à adapter à mon code. Le fait que ce ne soit pas un SaveAs mais un Export m'embête...
0
Réponse 4 / 6
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
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
0
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   61
 
Merci cs_Le Pivert, j'ai trouvé une solution. Je ne vais pas exporter le fichier, ça me donne un fichier "usine à gaz". Merci beaucoup d'avoir pris le temps de me répondre.

Cordialement.
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 6
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Bonjour Kuartz, Le Pivert,

Et si tu nous disais ce que tu veux faire exactement!
Enregistrer le graphique? le fichier? la feuille? Une image?
0
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   61
 
Bonjour pijaku,

Le but était d'enregistrer la feuille 1 où se trouve le graphique sous format PDF pour le visionner sur un UserForm et une fois le UserForm fermé, supprimer le PDF temporaire.
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761 > Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention  
 
Ok.
C'est plus clair.
Tu veux le "visionner" dans un UserForm, oui, mais dans quel type de contrôle? Contrôle Image?
0
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   61
 
Bonjour,

Le type de contrôle ne me dit rien. Oui pourquoi pas un contrôle image. Le but est simplement de visionner le graphique pour voir une évolution. L'idéal serait d'avoir un bouton sur le Userform pour soit quitter le graph et revenir à la base de recherche (donc quitter le Userform simplement) et un autre bouton pour exporter le graph en PDF vers une destination choisie par l'utilisateur (ouvrir la fenêtre standard d'enregistrement excel).

Merci de te pencher sur mon problème.

Cordialement.
0
Réponse 6 / 6
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
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
0
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   61
 
Wow ! Nice :) Merci je vais étudier tout ça et je reviens te jeter des fleurs :)
0
Kuartz Messages postés 852 Date d'inscription   Statut Membre Dernière intervention   61
 
Après adaptation, le code marche nickel ! Si j'avais pu trouver ce code je n'aurais pas eu besoin de t'embêter. Merci infiniment !

Cordialement.
0

Discussions similaires

Gif Instagram ne marche pas par messages
OceaneBD64 -
madmyke -

1 réponse