Résolu XL 2010 Enregistrer un onglet au format PDF par macro

Guy6363

XLDnaute Nouveau
Supporter XLD
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
 
Ce fil a été résolu! Aller à la solution…

Fichiers joints

Dernière édition:

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
 
Ce message a été identifié comme étant une solution!

Guy6363

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

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas