XL 2010 Enregistrer un onglet au format PDF par macro

Guy6363 · 18 Octobre 2020

Bonjour la compagnie

Est-il possible de copier un nom de fichier présent dans un onglet et enregistrer cet onglet (ouvert) au format PDF, dans un dossier spécifique (laissé au choix de l'utilisateur) ?
Sur la base de 3 cellules (voir exemple).
J'ai trouvé comment générer le nom du fichier (il y a sans doute une solution plus "noble")
mais quand je copie la cellule qui contient ce nom, je ne peux pas le coller dans la zone de saisie du nom de fichier dans l'explorateur.

Un grand merci d'avance pour votre aide
Guy

kiki29 · 18 Octobre 2020

Re, bref qqch comme ceci :

VB:

Option Explicit

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

Sub EnregistrerSous()
Dim sNomfichier As String
Dim oNomFichier As Variant, sExt As String

    ChDir ThisWorkbook.Path

    sNomfichier = Feuil8.Range("J28")
    sExt = ".pdf"
    If NomFichierValide(sNomfichier) = False Then...

kiki29 · 18 Octobre 2020

Salut, voir 1 2 3

Guy6363 · 18 Octobre 2020

kiki29 à dit:
Salut, voir 1 2 3

Merci pour ta rapide réponse, mais je ne vois que des solutions pour "fusion" et comme je suis une tanche en vba, après essais, j'ai constaté que ça ne répond pas à mon attente.
Merci quand même.
Guy

kiki29 · 18 Octobre 2020

Re, à toi de poursuivre

VB:

Option Explicit

Sub Tst()
Dim sNom As String
    sNom = Feuil8.Range("J28")
    If NomFichierValide(sNom) Then
        Feuil8.ExportAsFixedFormat Type:=xlTypePDF, _
                                   Filename:=ThisWorkbook.Path & "\" & sNom, _
                                   Quality:=xlQualityStandard, _
                                   IncludeDocProperties:=True, _
                                   IgnorePrintAreas:=False, _
                                   OpenAfterPublish:=False
    Else
        Feuil8.Range("J28").Select
        MsgBox "Nom de fichier invalide", vbCritical + vbOKOnly, "Nom de fichier"
    End If
End Sub

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

kiki29 · 18 Octobre 2020

Re, bref qqch comme ceci :

VB:

Option Explicit

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

Sub EnregistrerSous()
Dim sNomfichier As String
Dim oNomFichier As Variant, sExt As String

    ChDir ThisWorkbook.Path

    sNomfichier = Feuil8.Range("J28")
    sExt = ".pdf"
    If NomFichierValide(sNomfichier) = False Then
        Feuil8.Range("J28").Select
        MsgBox "Nom de fichier invalide", vbCritical + vbOKOnly, "Nom de fichier"
        Exit Sub
    End If

    oNomFichier = Application.GetSaveAsFilename(InitialFileName:=sNomfichier, _
                                                fileFilter:="Fichiers PDF (*" & sExt & ", *" & sExt)
    If oNomFichier <> False Then
        Feuil8.ExportAsFixedFormat Type:=xlTypePDF, _
                                   Filename:=oNomFichier, _
                                   Quality:=xlQualityStandard, _
                                   IncludeDocProperties:=True, _
                                   IgnorePrintAreas:=False, _
                                   OpenAfterPublish:=False
    End If
End Sub

Guy6363 · 18 Octobre 2020

kiki29 à dit:

Re, bref qqch comme ceci :

VB:

Option Explicit

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

Sub EnregistrerSous()
Dim sNomfichier As String
Dim oNomFichier As Variant, sExt As String

    ChDir ThisWorkbook.Path

    sNomfichier = Feuil8.Range("J28")
    sExt = ".pdf"
    If NomFichierValide(sNomfichier) = False Then
        Feuil8.Range("J28").Select
        MsgBox "Nom de fichier invalide", vbCritical + vbOKOnly, "Nom de fichier"
        Exit Sub
    End If

    oNomFichier = Application.GetSaveAsFilename(InitialFileName:=sNomfichier, _
                                                fileFilter:="Fichiers PDF (*" & sExt & ", *" & sExt)
    If oNomFichier <> False Then
        Feuil8.ExportAsFixedFormat Type:=xlTypePDF, _
                                   Filename:=oNomFichier, _
                                   Quality:=xlQualityStandard, _
                                   IncludeDocProperties:=True, _
                                   IgnorePrintAreas:=False, _
                                   OpenAfterPublish:=False
    End If
End Sub

Chapeau !
Je suis bleuté par votre efficacité à comprendre ma question et à trouver la solution adéquate !
Un grand merci à vous...
et à la communauté d'entraide.

Cordialement
Guy

XL 2010 Enregistrer un onglet au format PDF par macro

Guy6363

XLDnaute Nouveau

Pièces jointes

kiki29

kiki29

XLDnaute Barbatruc

Guy6363

XLDnaute Nouveau

kiki29

XLDnaute Barbatruc

kiki29

XLDnaute Barbatruc

Guy6363

XLDnaute Nouveau

Discussions similaires