Macro sauvegarde PDF ajout du nom de fichier selon cellule

Bonjour! J'ai réussis a programmer un bouton qui permet une sauvegarde en PDF et un choix d'endroit pour la sauvegarde. Par contre il faut y mettre un nom de fichier. J'aimerais que le nom de fichier ce génère automatiquement en même temps et sois relier avec un nom de cellule. Cette cellule dois être cliquer pour faire un choix de nom d'employé. Est-ce possible de l'ajouter dans ce code?

Voici mon code:

Private Sub cbSaveAsPDF_Click()

Dim sPath As String

Dim sFile As Variant

Dim ws As Worksheet

On Error GoTo ErrHandle

sPath = ThisWorkbook.Path & "\" & "Sheet1 " & Me.Range("B2")

sFile = Application.GetSaveAsFilename _

(InitialFileName:=sPath, _

FileFilter:="PDF Files (*.pdf), *.pdf", _

Title:="Select Folder and File Name to save")

If sFile = "False" Then

MsgBox ("Please Choose A File Name")

Exit Sub

End If

Me.ExportAsFixedFormat _

Type:=xlTypePDF, _

FileName:=sFile, _

Quality:=xlQualityStandard, _

IncludeDocProperties:=True, _

IgnorePrintAreas:=False, _

OpenAfterPublish:=False

Exit Sub

ErrHandle:

MsgBox ("Document Not Saved")

End Sub

Bonjour,

De ce que je comprends !?

Cdlt.

Private Sub cbSaveAsPDF_Click()
Dim sPath As String, sFile As String, sFullName As String

    On Error GoTo ErrHandler

    If Not IsEmpty(Me.Range("B2")) Then
        sPath = ThisWorkbook.Path & Application.PathSeparator
        sFile = Me.Range("B2").Value & ".pdf"
        sFullName = sPath & sFile
        Me.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=sFullName, _
                Quality:=xlQualityStandard
    End If

ExitHandler:
    Exit Sub
ErrHandler:
    MsgBox "Erreur : " & Err.Number & Chr(10) & Err.Description
    Resume ExitHandler
End Sub

Je suis vraiment débutante avec les macros. J'ai trouver celui ci sur Google et il fonctionne bien pour moi. Je croyais qu'il prendrais en ligne de compte le nom de la cellule B2 comme nom de fichier, mais non.

Tu me suggère de le remplacer par ce que tu as mit?

Je viens de le tester….la seul chose c'est que je n'ai plus l'option de l'emplacement de sauvegarde :( et j'ai oublier de mentionner que ca dois etre le nom de deux cellule qui fait le nom du fichier...en fait je dois ajouter l'heure en plus du nom et c'est la cellule I2 qui contient une formule (NOW)

Re,

La procédure enregistre la feuille active du classeur sous le nom inscrit en cellule B2 dans le répertoire ou est enregistré le classeur actif.

Regarde le fichier joint.

A te relire.

Cdlt

J'ai réussis a modifier le nom de sauvegarde et je suis toujours a la recherche du code qui me permet de choisir l'endroit de sauvegarde.

En rouge la modification:

Private Sub cbSaveAsPDF_Click()

Dim sPath As String, sFile As String, sFullName As String

On Error GoTo ErrHandler

If Not IsEmpty(Me.Range("B2")) Then

sPath = ThisWorkbook.Path & Application.PathSeparator

sFile = Me.Range("B2").Value & Format(Range("I2").Value, "hh-mm-ss") & ".pdf"

sFullName = sPath & sFile

Me.ExportAsFixedFormat _

Type:=xlTypePDF, _

FileName:=sFullName, _

Quality:=xlQualityStandard

End If

ExitHandler:

Exit Sub

ErrHandler:

MsgBox "Erreur : " & Err.Number & Chr(10) & Err.Description

Resume ExitHandler

End Sub

Bonjour,

Une mise à jour avec le choix du répertoire pour l'enregistrement du pdf.

Cdlt.

Private Sub CommandButton1_Click()
Dim sFile As String, FileSaveName

    On Error GoTo ErrHandler

    If Not IsEmpty(Me.Range("B2")) And Not IsEmpty(Me.Range("I2")) Then
        sFile = Me.Range("B2").Value & Format(Me.Range("I2").Value, "hh-mm-ss")
        FileSaveName = Application.GetSaveAsFilename _
                       (InitialFileName:=sFile, _
                        filefilter:="Fichier PDF(*.pdf), *.pdf")
        If FileSaveName <> False Then
            Me.ExportAsFixedFormat _
                    Type:=xlTypePDF, _
                    Filename:=FileSaveName, _
                    Quality:=xlQualityStandard
        End If
    End If

ExitHandler:
    Exit Sub
ErrHandler:
    MsgBox "Erreur : " & Err.Number & Chr(10) & Err.Description
    Resume ExitHandler
End Sub