Microsoft 365 Exporter une feuille graphique en pdf

  • Initiateur de la discussion Initiateur de la discussion loul03
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

loul03

XLDnaute Occasionnel
Bonjour

J'ai un graphique sur une feuille spéciale graphique que j'aimerais exporter en pdf, et enregistrer automatiquement dans un dossier.

La formule employée habituellement ne fonctionne pas.

Savez vous quelles sont les dénominations à faire évoluer svp?

Sheets("Graphique").Select
Dim ladate As String, periode As String, lerep As String
ladate = Format(Date, "yyyymmdd")
periode = Worksheets("Rapport Actia").Range("p2").Value
lerep = ThisWorkbook.Path & "\Historique\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=lerep & ladate & " - Conso gasoil - Période " & periode & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Sheets("Graphique").Select

Par avance merci beaucoup

bonne journée
loul
 
Salut, une version qui teste si le nom de fichier est valide, crée le dossier de sauvegarde, en plus les doublons éventuels sont gérés via un indice : (001) (002) etc.
VB:
Option Explicit

Private Function CreationDossier(ByVal sChemin As String) As Boolean
Dim i As Long, sTmp As String, Ar() As String
    If InStr(sChemin, ":") = 0 Then
        Ar = Split(CurDir & "\" & sChemin, "\")
    Else
        Ar = Split(sChemin, "\")
    End If

    sTmp = Ar(0)
    ChDrive sTmp

    For i = LBound(Ar) + 1 To UBound(Ar)
        If Ar(i) <> "" Then
            sTmp = sTmp & "\" & Ar(i)
            On Error Resume Next
            MkDir sTmp
            On Error GoTo 0
        End If
    Next i

    If Dir$(sChemin, vbDirectory) = vbNullString Then
        CreationDossier = False
    Else
        CreationDossier = True
    End If
End Function

Private Function NomFichierValide(sChaine As String) As Boolean
Dim i As Long
Const sCaracInterdits As String = """*/:<>?[\]|"
    NomFichierValide = True
    If Len(sChaine) = 0 Then
        NomFichierValide = False
        Exit Function
    End If
    For i = 1 To Len(sCaracInterdits)
        If InStr(sChaine, Mid$(sCaracInterdits, i, 1)) > 0 Then
            NomFichierValide = False
            Exit Function
        End If
    Next i
End Function

Private Function RenommerFichier(sDossier As String, sNomfichier As String) As String
Dim sNouveauNom As String
Dim sPre As String, sExt As String
Dim i As Long
Dim FSO As Object

    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FileExists(sDossier & "\" & sNomfichier) Then
        sNouveauNom = sNomfichier
        sPre = FSO.GetBaseName(sNomfichier)
        sExt = FSO.GetExtensionName(sNomfichier)

        i = 0
        While FSO.FileExists(sDossier & "\" & sNouveauNom)
            i = i + 1
            sNouveauNom = sPre & Chr(40) & Format(i, "000") & Chr(41) & Chr(46) & sExt
        Wend
        sNomfichier = sNouveauNom
    End If
    Set FSO = Nothing

    RenommerFichier = sDossier & "\" & sNomfichier
End Function

Sub Tst()
Dim LaDate As String, Periode As String, LeRep As String
Dim sDossier As String, sFichier As String

    LaDate = Format(Date, "yyyymmdd")
    Periode = Worksheets("Rapport Actia").Range("p2").Text

    If NomFichierValide(Periode) = False Then
        MsgBox "Nom de fichier invalide !", vbOKCancel + vbCritical
        With Worksheets("Rapport Actia")
            .Activate
            .Range("p2").Select
        End With
        Exit Sub
    End If

    Application.ScreenUpdating = False

    LeRep = ThisWorkbook.Path
    sDossier = "Historique"

    CreationDossier (LeRep & "\" & sDossier)

    sFichier = LaDate & " - Conso gasoil - Période " & Periode & ".pdf"
    sFichier = RenommerFichier(LeRep & "\" & sDossier, sFichier)

    Graph1.ExportAsFixedFormat Type:=xlTypePDF, _
                               Filename:=sFichier, _
                               Quality:=xlQualityStandard, _
                               IncludeDocProperties:=True, _
                               IgnorePrintAreas:=False, _
                               OpenAfterPublish:=True
    Application.ScreenUpdating = True
End Sub
 

Pièces jointes

  • 1.png
    1.png
    24.4 KB · Affichages: 16
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 Problème macro
Réponses
4
Affichages
245
Réponses
10
Affichages
547
Réponses
3
Affichages
672
Réponses
3
Affichages
887
Réponses
2
Affichages
586
Retour