XL 2010 Enregistrer un onglet au format PDF par macro

Guy6363

XLDnaute Nouveau
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
 

Pièces jointes

  • Generer un nom de fichier.xlsm
    26.8 KB · Affichages: 24
Dernière édition:
Solution
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

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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

XLDnaute Nouveau
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
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 915
Membres
101 837
dernier inscrit
Ugo