Exporter graphique sans fond

[Muad]

Salut tous le monde,

Je cherche, en vain, à exporter plusieurs graphiques de manière rapide, sans fond blanc et donc transparent.

L'idée, ce serait de mettre à jour une infographie sous illustrator ou photoshop avec les graphiques que j'ai réalisés sous excel.
Pour cela j'ai pensé à utiliser un logiciel de macro sous windows qui copie et colle les graphiques dans illustrator ou photoshop.
Seulement, lorsque je copie et que je colle un graphique, il y a le fond blanc présent. J'ai pourtant un fond transparent sur excel.

Seul inconvénient : il faut que ce soit une manipulation rapide, car le fichier excel va être modifié en continue...

Je m'en remet donc à vous, si quelqu’un a une idée, je vous remercie par avance.

 

[mapomme]

Re : Exporter graphique sans fond

Bonsoir Muad,

Une piste dans le fichier joint. Quand on change les valeurs en C5 ou D5, le graphique est exporté en format PNG sous la racine du disque C: et sous le nom Graphique 1.png.

Quand j'ouvre ensuite le fichier .png avec un logiciel de traitement d'image (pas Illustrator mais un autre: Paint Shop Pro), le fichier est importé avec un fond transparent. Je ne connais pas Illustrator mais il y a peut-être moyen d'automatisation l'importation de fichier .

Le code est dans le module de la feuille "Feuil1" :

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("c5:d5")) Then
    Me.ChartObjects("Graphique 1").Chart.Export _
        Filename:="c:\" & "Graphique 1" & ".png", FilterName:="PNG"
  End If
End Sub

 

[Muad]

Re : Exporter graphique sans fond

Salut et merci,

Seulement je n'arrive pas à lancer la macro...

Excel me lance une fenêtre avec écrit : "Nom de la macro"

Désolé de mon amateurisme

Modif1 : C'est bon j'avais pas compris le système de l'enregistrement lorsque l'on change les données. C'est génial ca marche parfaitement, le fond est bien transparent...

Puis-je te demander des modifications stp ? Il faudrait que je puisse le déclencher seulement sur commande et qu'il exporte le graphique sélectionné ou les graphique sélectionnés. Est-ce possible ?

Je te remercie d'avance

 

[mapomme]

Re : Exporter graphique sans fond

re,

Salut et merci,

Seulement je n'arrive pas à lancer la macro...

Excel me lance une fenêtre avec écrit : "Nom de la macro"

Désolé de mon amateurisme

Ne soyez pas désolé .

Normalement la macro n'a pas à être lancée. Elle se déclenche automatiquement quand une des valeurs des cellules C5 ou D5 est modifiée.

Je vous joins une version v2 avec l'ajout d'un bouton pour déclencher sur ordre l'exportation du graphique. J'espère que cela fonctionnera mieux.

le code:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("c5:d5")) Is Nothing Then Exporter
End Sub

Sub Exporter()
    Me.ChartObjects("Graphique 1").Chart.Export _
        Filename:="c:\" & "Graphique 1" & ".png", FilterName:="PNG"
End Sub

 

[mapomme]

Re : Exporter graphique sans fond

re,

(...)Puis-je te demander des modifications stp ? Il faudrait que je puisse le déclencher seulement sur commande et qu'il exporte le graphique sélectionné ou les graphique sélectionnés. Est-ce possible ? (...)

Nos messages se sont croisés . Pour les modifications, je vais m'y atteler mais ce sera après le diner ...

 

[Muad]

Re : Exporter graphique sans fond

^^ Merci beaucoup c'est pas urgent, il faudrait aussi que les graphiques s'exporter sous différent nom (graphique1,2,3...) sinon cela va écrasé les graphiques précédent il me semble...

Merci beaucoup

 

[Staple1600]

Re : Exporter graphique sans fond

Bonsoir à tous

Une proposition basique pour exporter tous les graphiques d'une feuille.
(test OK sur Excel 2013)
(avec trois exemples d'écriture pour lancer l'export.

Sub testI()
ExportGraphs ActiveSheet, "C:\Temp\"
End Sub

Sub testII()
ExportGraphs Feuil1, "C:\Temp\"
End Sub

Sub testIII()
ExportGraphs Sheets("Feuil1"), "C:\Temp\"
End Sub

Private Sub ExportGraphs(Feuille As Worksheet, strPath As String)
Dim cht As ChartObject, x&
If Feuille.ChartObjects.Count = 0 Then Exit Sub
For Each cht In Feuille.ChartObjects
cht.Chart.Export strPath & Feuille.Name & "Graphique_" & x & ".png", "PNG"
x = x + 1
Next cht
End Sub

 

[Muad]

Re : Exporter graphique sans fond

Salut,

Je te remercie de ta proposition, seulement il faut que je puisse sélectionner les graphiques que je souhaite exporter. Je dispose d'une cinquantaine de graphique dans cette feuille... (je peux pas vous l'a partager elle est trop lourde et elle rame énormément...)

Merci d'avoir pris le temps de me répondre

 

[Staple1600]

Re : Exporter graphique sans fond

Bonjour à tous


Une francisation d'un code de Jon Peltier, grand amateur de graphiques s'il en est
Le code exporte le graphique sélectionné.

Sub ExportChart()
Dim sChartName$, sFileName$, sPathName$, sPrompt$, sCurDir$, iOverwrite&

If ActiveSheet Is Nothing Then GoTo ExitSub
If ActiveChart Is Nothing Then GoTo ExitSub

  sCurDir = CurDir
  sPathName = ActiveWorkbook.Path
  If Len(sPathName) > 0 Then
    ChDrive sPathName
    ChDir sPathName
  End If
  sFileName = "ImageDuGraphique.png"
  Do
    sChartName = Application.GetSaveAsFilename(sFileName, "Fichier PNG ,*.png", , _
        "Choisissez un dossier et saisir le nom l'image désiré")
    If Len(sChartName) = 0 Then GoTo ExitSub
    If sChartName = "False" Then GoTo ExitSub

sChartName = sChartName

    If Not FileExists(sChartName) Then Exit Do
    sFileName = FullNameToFileName(sChartName)
    sPathName = FullNameToPath(sChartName)
    sPrompt = "Un fichier nommé " & sFileName & " existe déj dans: " & sPathName
    sPrompt = sPrompt & vbNewLine & vbNewLine & "Voulez-vous le remplacer par celui-ci?"
    iOverwrite = MsgBox(sPrompt, vbYesNoCancel + vbQuestion, "Fichier déjà existant")
    Select Case iOverwrite
      Case vbYes
        Exit Do
      Case vbNo
        ' do nothing, loop again
      Case vbCancel
        GoTo ExitSub
    End Select
  Loop
  ActiveChart.Export sChartName, "PNG"

ExitSub:
  ChDrive sCurDir
  ChDir sCurDir
End Sub
Function FileExists(ByVal FileSpec As String) As Boolean
  ' Karl Peterson MS VB MVP
  Dim Attr As Long
  ' Guard against bad FileSpec by ignoring errors
  ' retrieving its attributes.
  On Error Resume Next
  Attr = GetAttr(FileSpec)
  If Err.Number = 0 Then
    ' No error, so something was found.
    ' If Directory attribute set, then not a file.
    FileExists = Not ((Attr And vbDirectory) = vbDirectory)
  End If
End Function
Function FullNameToFileName(sFullName As String) As String
  Dim k As Integer
  Dim sTest As String
  If InStr(1, sFullName, "[") > 0 Then
    k = InStr(1, sFullName, "[")
    sTest = Mid$(sFullName, k + 1, InStr(1, sFullName, "]") - k - 1)
  Else
    For k = Len(sFullName) To 1 Step -1
      If Mid$(sFullName, k, 1) = "\" Then Exit For
    Next k
    sTest = Mid$(sFullName, k + 1, Len(sFullName) - k)
  End If
  FullNameToFileName = sTest
End Function
Function FullNameToPath(sFullName As String) As String
  ' does not include trailing backslash
  Dim k As Integer
  For k = Len(sFullName) To 1 Step -1
    If Mid$(sFullName, k, 1) = "\" Then Exit For
  Next k
  If k < 1 Then
    FullNameToPath = ""
  Else
    FullNameToPath = Mid$(sFullName, 1, k - 1)
  End If
End Function

 

[mapomme]

Re : Exporter graphique sans fond

Bonjour Muad, Staple1600 ,

Bon, ben... je n'ai plus rien à faire. C'est top! C'est vrai que hier soir après diner, j'ai piqué une ronflette pas piquée des hannetons

 

[Staple1600]

Re : Exporter graphique sans fond

Bonjour mapomme


mapomme
Tu peux tenter la concision* vu que le code original date de 2008
(J'avais commencé mais je te laisse la place , à mon tour d'aller faire ma ronflette devant mon TV set )

* : j'étais parti sur faire l'impasse sur l'emploi des deux fonctions et de passer par un BrowseForFolder (pour le choix du dossier)

 

[Muad]

Re : Exporter graphique sans fond

Re salut,

Merci beaucoup cela fonctionne.

Désolé mais est-il possible d'apporter deux modifications svp ?

1- Possibilité de sélectionné plusieurs graphiques qui s'enregistre sous différentes images : par exemple trois graphiques sélectionnés qui s'exporte sous 3 images (graphique 1.png, graphique 2.png, graphique 3 .png)

2- Quand la macro ce lance est-il possible qu'il enregistre directement les graphique dans un dossier prédéfini sous un nom de base par exemple : "graphique1",2,3,4

Merci beaucoup à vous deux

 

[Staple1600]

Re : Exporter graphique sans fond

Bonjour à tous


Encore lui! sacré Jon
Je parlais de concision
Il reste à modifier en testant si la Selection est un Graphique
Ça tombe bien, j'ai aussi cela sous le coude
(voir la macro test plus bas)
Je vous laisse donc mixer ces deux codes et je retourne faire ma ronflette

Sub ExportAllChartsOnActiveSheet()
'code original Jon Peltier
'francisé par l'Agrafe
'ou pour être exact formaté à la française niveau date ;-)
Dim fname$, i&, sh As Object

If Len(ActiveWorkbook.Path) > 0 Then 
 fname = ActiveWorkbook.Path & "\"
 End If

  ' unique name (try not to overwrite existing charts
  fname = fname & "graphique_" & Format(Now, "ddmmyyyy_hhmmss")

  For Each sh In ActiveWorkbook.Sheets
    If TypeName(sh) = "Chart" then
      sh.Export fname & " " & sh.Name & ".png"
    End If

    For i = 1 to ActiveSheet.ChartObjects.Count
      ActiveSheet.ChartObjects(i).Chart.Export fname & " " & sh.Name & " " & CStr(i) & ".png"
    Next
  Next
End Sub

Sub Test() 
'Merci à Andrew Poulsom pour ce petit code ;-)
    Dim Item As Variant 
    For Each Item In Selection
         If TypeName(Item) = "ChartObject" Then
 '           Do stuff 
            MsgBox Item.Name
         End If
     Next Item 
End Sub

 

[Muad]

Re : Exporter graphique sans fond

Merci et bonne ronflette ^^

Si quelqu'un peut m'expliquer ce que je dois faire de ces deux codes ?

 

[Staple1600]

Re : Exporter graphique sans fond

Re


Bon tant pis pour la ronflette
Voici un code fonctionnel mais à peaufiner

Sub ExportSelectedChartsOnActiveSheet()
Dim fname$, i&, sh As Object
If Len(ActiveWorkbook.Path) > 0 Then
fname = ActiveWorkbook.Path & "\"
End If
Dim Item As Variant
For Each Item In Selection
On Error Resume Next
If TypeName(Item) = "ChartObject" Then
ActiveSheet.ChartObjects(Item.Name).Chart.Export fname & Item.Name & ".png"
End If
Next Item
End Sub

NB: Muad, c'était pas compliqué à faire comme mixage, non ?