XL 2010 Enregistrer un onglet au format PDF par macro

[Guy6363]

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]

Salut, voir 1 2 3

 

[Guy6363]

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]

Re, à toi de poursuivre

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]

Re, bref qqch comme ceci :

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]

Re, bref qqch comme ceci :

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