Automatisation production camemberts et export en format JPEG

B

boblebob

XLDnaute Nouveau
Bonjour,

Je dispose d'un tableur avec pour chaque enregistrement un ID et des données de % permettant de réaliser un camembert.

Ce que je souhaite faire c'est exporter, pour chacune des lignes de mon tableur, un camembert dans un fichier .jpeg dont le nom de fichier reprendra le contenu de mon champ ID.

Est-ce que cela vous paraît possible?

Merci par avance pour vos réponses!
 
Trier par date Trier par votes
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Automatisation production camemberts et export en format JPEG

I Le fromager :D

Qu'est-ce que tu as comme fromage à vendre aujourd'hui? ;)

Tu voudrais bien mettre un pdf pour voir au juste de quoi il s'agit? Moi pas avoir compris, desolato.


A+ :cool:
 
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Automatisation production camemberts et export en format JPEG

Re,

si cest pour ne pas voir l'encadré en gris qui s'affiche dans le pdf. A inserer avant t = Timer > Loop

Code: 
With ActiveSheet.ChartObjects(1)
        With .Border
         .Weight = xlThick
         .LineStyle = xlAutomatic
         .ColorIndex = xlNone
         End With
     End With


A+ :cool:
 
Vote positif 0 Vote négatif
B

boblebob

XLDnaute Nouveau
Re : Automatisation production camemberts et export en format JPEG

Merci pour ton retour rapide l'ami fromager :)

malheureusement cela ne change rien chez moi en intégrant le bout de code...
Code: 
Sub Camembert()
Dim plage As Range
Dim chemin, nom As String
Dim x, i As Integer
Dim Graph As ChartObject
Dim t As Double
 
 On Error Resume Next
    Set Graph = Sheets("Feuil1").ChartObjects.Add(227, 20, 190, 160)
    i = 1
    For x = 1 To 166
    i = i + 1
    Set plage = Sheets("Feuil1").Range("B1:F1," & "B" & i & ":" & "F" & i)
    ActiveSheet.ChartObjects(1).Activate
    ActiveSheet.ChartObjects(1).Name = ActiveSheet.Range("A" & i)
    nom = ActiveSheet.Range("A" & i) & ".pdf"
    ActiveChart.ChartArea.Select
    ActiveChart.ChartType = xlDoughnut
    ActiveChart.SetSourceData Source:=plage, PlotBy:=xlRows
    With ActiveSheet.ChartObjects(1)
        With .Border
         .Weight = xlThick
         .LineStyle = xlAutomatic
         .ColorIndex = xlNone
         End With
     End With
    t = Timer + 0.8: Do Until Timer > t: DoEvents: Loop
        ActiveChart.Legend.Delete
    chemin = ThisWorkbook.Path & "\Images\"
    ActiveChart.ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & nom, _
                                          Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                                          IgnorePrintAreas:=False, OpenAfterPublish:=False
    
    

    
    
    Next x
        
End Sub

Sub MiseEnForme()
    ActiveChart.SeriesCollection(1).Points(1).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(241, 95, 42)
        .Solid
    End With
    ActiveChart.SeriesCollection(1).Points(2).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(242, 238, 123)
        .Transparency = 0
        .Solid
    End With
    ActiveChart.SeriesCollection(1).Points(3).Select
     With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(38, 88, 168)
        .Solid
    End With
    ActiveChart.SeriesCollection(1).Points(4).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(111, 207, 243)
        .Transparency = 0
        .Solid
    End With
    ActiveChart.SeriesCollection(1).Points(5).Select
     With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(106, 182, 127)
        .Solid
    End With
    ActiveChart.SeriesCollection(1).Points(6).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 176, 240)
        .Transparency = 0
        .Solid
    End With
End Sub

Ca marche chez toi?
 
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Automatisation production camemberts et export en format JPEG

Hello boblebob,

On se fait une raclette avec ton code? ;)

Trêve de plaisenterie, voici mon code. Comme moi j'ai fait on ne vois plus l'encadré gris.


Code: 
Sub Camembert()
Dim plage As Range
Dim Chemin As String
Dim x, i As Integer
Dim Graph As ChartObject
Dim t As Double
 
 On Error Resume Next
    Set Graph = Sheets("Feuil1").ChartObjects.Add(227, 20, 190, 160)
    i = 1
    For x = 1 To 52
    i = i + 1
    Set plage = Sheets("Feuil1").Range("B1:F1," & "B" & i & ":" & "F" & i)
    ActiveSheet.ChartObjects(1).Activate
    
        With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = "Poduction Secteur " & ActiveSheet.Range("A" & i)
        End With
    
    With ActiveChart.ChartTitle.Characters
    .Font.Size = 10
    End With
    
     With ActiveChart.SeriesCollection(1).Points(1).Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(205, 104, 155)
        .Transparency = 0
        .Solid
    End With
    With ActiveChart.SeriesCollection(1).Points(2).Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(153, 51, 102)
        .Transparency = 0
        .Solid
    End With
     With ActiveChart.SeriesCollection(1).Points(3).Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 255, 153)
        .Transparency = 0
        .Solid
    End With
    With ActiveChart.SeriesCollection(1).Points(4).Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 102, 204)
        .Transparency = 0
        .Solid
    End With
     With ActiveChart.SeriesCollection(1).Points(5).Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 255, 204)
        .Transparency = 0
        .Solid
    End With
    With ActiveChart.SeriesCollection(1).Points(6).Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects(1).Name = ActiveSheet.Range("A" & i)
    nom = "Poduction Secteur " & ActiveSheet.Range("A" & i) & ".gif"
    ActiveChart.ChartArea.Select
    ActiveChart.ChartType = xlDoughnut
    ActiveChart.SetSourceData Source:=plage, PlotBy:=xlRows
    
    With ActiveSheet.ChartObjects(1)
        With .Border
         .Weight = xlThick
         .LineStyle = xlAutomatic
         .ColorIndex = xlNone
         End With
     End With
    t = Timer + 0.8: Do Until Timer > t: DoEvents: Loop
        'ActiveChart.Legend.Delete
    Chemin = ThisWorkbook.Path & "\Images\"
   Call Creer_PDF
    ActiveChart.Export Chemin & nom, "GIF"
    Next x
          
End Sub

Sub Creer_PDF()
Dim Fname, Chemin As String

    Chemin = ThisWorkbook.Path & "\PDF\"
    Fname = Chemin & Application.PathSeparator
    Fname = Fname & "Poduction Secteur " & ActiveSheet.ChartObjects(1).Name & ".pdf"
    
    ActiveChart.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=Fname, _
            Quality:=xlQualityStandard, _
            includedocproperties:=True, _
            ignoreprintareas:=False, _
            openafterpublish:=False
   
End Sub




A+ :cool:
 

Pièces jointes

  • Poduction Secteur A.pdf
    178.4 KB · Affichages: 30
Dernière édition:
Vote positif 0 Vote négatif
B

boblebob

XLDnaute Nouveau
Re : Automatisation production camemberts et export en format JPEG

L'usine de fromage n'est pas encore fonctionnelle malgré ton aide :)

Je ne comprends pas bien pourquoi le format GIF est déclaré dans ton code? J'ai modifié pour obtenir du PDF mais sans succès...

Tant que j'y suis je précise mon besoin... :)

Un fichier PDF sans titre et légende
Un nom de fichier qui se rapporte au champ ID

Pour être honnête je n'ai pas encore pris le temps de vraiment chercher la solution mais si tu veux t'y pencher en tant que fin gourmet je suis preneur :)

Merci à toi!
 
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Automatisation production camemberts et export en format JPEG

Re,

Format gif, par-ce que je crée des images.

Ces lignes si référant, tu peux les supprimer.

Code: 
nom = "Poduction Secteur " & ActiveSheet.Range("A" & i) & ".gif"

 i = 1
    For x = 1 To 52
    i = i + 1
    Set plage = Sheets("Feuil1").Range("B1:F1," & "B" & i & ":" & "F" & i)
    ActiveSheet.ChartObjects(1).Activate
   
        With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = "Poduction Secteur " & ActiveSheet.Range("A" & i)
        End With

 Chemin = ThisWorkbook.Path & "\Images\"
    ActiveChart.Export Chemin & nom, "GIF"
    Next x

et tu remet ceci ActiveChart.Legend.Delete en enlevant le '

Dans la macro PDF modifie la ligne comme ceci
Fname = Fname & ActiveSheet.ChartObjects(1).Name & ".pdf"


ça va allez comme ça? ;)



A+ :cool:
 
Dernière édition:
Vote positif 0 Vote négatif
B

boblebob

XLDnaute Nouveau
Re : Automatisation production camemberts et export en format JPEG

Désolé mais il y a quelque chose qui m'a échappé car j'ai repris tes indications et maintenant cela n'exporte plus rien...

Si tu as une idée..

PS c'est quoi les balises pour afficher du code VBA?

Code: 
Sub Camembert()
Dim plage As Range
Dim Chemin As String
Dim x, i As Integer
Dim Graph As ChartObject
Dim t As Double
 
 On Error Resume Next
    Set Graph = Sheets("Feuil1").ChartObjects.Add(227, 20, 190, 160)
   
    With ActiveChart.ChartTitle.Characters
    .Font.Size = 10
    End With
   
     With ActiveChart.SeriesCollection(1).Points(1).Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(205, 104, 155)
        .Transparency = 0
        .Solid
    End With
    With ActiveChart.SeriesCollection(1).Points(2).Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(153, 51, 102)
        .Transparency = 0
        .Solid
    End With
     With ActiveChart.SeriesCollection(1).Points(3).Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 255, 153)
        .Transparency = 0
        .Solid
    End With
    With ActiveChart.SeriesCollection(1).Points(4).Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 102, 204)
        .Transparency = 0
        .Solid
    End With
     With ActiveChart.SeriesCollection(1).Points(5).Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 255, 204)
        .Transparency = 0
        .Solid
    End With
    With ActiveChart.SeriesCollection(1).Points(6).Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects(1).Name = ActiveSheet.Range("A" & i)
    ActiveChart.ChartArea.Select
    ActiveChart.ChartType = xlDoughnut
    ActiveChart.SetSourceData Source:=plage, PlotBy:=xlRows
   
    With ActiveSheet.ChartObjects(1)
        With .Border
         .Weight = xlThick
         .LineStyle = xlAutomatic
         .ColorIndex = xlNone
         End With
     End With
    t = Timer + 0.8: Do Until Timer > t: DoEvents: Loop
        ActiveChart.Legend.Delete
   Call Creer_PDF

         
End Sub

Sub Creer_PDF()
Dim Fname, Chemin As String

    Chemin = ThisWorkbook.Path & "\PDF\"
    Fname = Chemin & Application.PathSeparator
    Fname = Fname & ActiveSheet.ChartObjects(1).Name & ".pdf"
   
    ActiveChart.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=Fname, _
            Quality:=xlQualityStandard, _
            includedocproperties:=True, _
            ignoreprintareas:=False, _
            openafterpublish:=False
   
End Sub
 
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Automatisation production camemberts et export en format JPEG

I boblebob

Voilà, j'ai modifié la macro pour en avoir qu'une seule. J'ai fait un test sans soucis.

Pour afficher le texte en couleur dans les balises VBA: CODE=VBA] LE CODE [/CODE




A+ :cool:
 

Pièces jointes

  • automatisation_exportJpeg_camemberts.xlsm
    23.7 KB · Affichages: 25
Vote positif 0 Vote négatif
Lone-wolf

Lone-wolf

XLDnaute Barbatruc
Re : Automatisation production camemberts et export en format JPEG

Re,

Non, chez moi les graphiques s'affichent normalement. Ce que tu peux faire, c'est de créer un nouveau fichier, ajouter quelques données, copier la macro dans le nouveau module et faire un test. Si tu utilise Acrobate Reader essaie de faire une mise à jour.
 

Pièces jointes

  • GPH 2.pdf
    8.3 KB · Affichages: 21
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

Nico2978
  • Résolu(e)
XL 2019 Aide pour un module d'archivage de feuille en pdf dans répertoire
Réponses
5
Affichages
251
Nico2978
Nico2978
D
  • Question
Microsoft 365 Remplacer des données manquantes et en ajouter d'autres
Réponses
3
Affichages
107
DFER
D
A
  • Question
Microsoft 365 Enregistrer des PDF et JPEG automatiquement dont les liens sont dans un fichier excel.
Réponses
3
Affichages
408
Alternance
A
N
  • Question
Microsoft 365 Exporter en csv vers un sharepoint
Réponses
0
Affichages
232
Negalo
N
B
  • Question
XL 2013 Export Base de donnée biodiversité et créer tableau synthèse
Réponses
3
Affichages
432
chris
chris
M
  • Résolu(e)
Microsoft 365 enregistrement copie du classeur ouvert avec mot de passe et incrémentation
2
Réponses
27
Affichages
1 K
meyscal
M
Frank2000
  • Question
Microsoft 365 Exporter massivement le contenu de chaque cellule en .jpg ou .txt
Réponses
4
Affichages
790
Frank2000
Frank2000
N
  • Question
XL pour MAC Créer un tableau avec liste déroulante changeant en fonction du sujet
Réponses
8
Affichages
1 K
Neckramhon
N
J
  • Question
Microsoft 365 Excel-VBA Afficher un texte en fonction d'une liste et tableau
Réponses
2
Affichages
596
Juliennné23
J
S
  • Résolu(e)
XL 2016 Tri et copié coller de valeur selon date et varibale en automatique
2
Réponses
29
Affichages
1 K
StanislasC
S

Membres actuellement en ligne

22 membres et 69 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 496
Messages
2 088 976
Membres
103 995
dernier inscrit
Flodk