Enregistrer feuille xls en pdf avec nom de fichier issu cellules fusionnées

Bonjour à tous et à toutes

Je viens vers vous en tant que novice du VBA. Merci par avance pour votre aide.

Je souhaite à la fin de ma macro enregistrer la feuille active en document pdf dans un dossier spécifique avec comme nom de fichier une des cellules de la feuille...la problématique c'est que cette cellule est une cellule fusionnée. Si je défusionne la cellule cela marche avec la commande Value. Mais si je laisse la fusion tel quel avec la commande Select, elle me prend bien les deux cellules mais je n'arrive pas à incorporer la fonction Value pour avoir le texte ? Je ne sais pas si je suis clair désolé par avance. Voici le code :

Sub Macro12()

'

' Macro12 Macro

'

'

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

"C:\Users\ar...\OneDrive\Bureau\PDF clients\" & Range("D13:E13").Select & ".pdf", Quality:= _

xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _

OpenAfterPublish:=False

End Sub

Bonjour Armorik75

Si tu mettais seulement Range("D13")

Sub Macro12()
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\ar...\OneDrive\Bureau\PDF clients\" & Range("D13") & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub

cdt

Henri

Bonjour Henri

Merci pour ton retour rapide. J'avais déjà essayé mais cela ne marche pas. Ca identifie erreur d'execution 1004

J'ai essayé avec une cellule fusionnée et ça marche

Dim repertoire= "C:\Users\ar...\OneDrive\Bureau\PDF clients\" 'à adapter
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Repertoire & Range("D13") & ".pdf"

Cdt

Henri

Bon là je comprends plus je viens de retaper ton code et cela fonctionne !! Pourtant j'avais tenté la toute première fois comme cela et cela ne marchait pas...mais peut importe j'essayerai de comprendre plus tard.

Un grand merci Henri.

je vais abuser de votre savoir et de votre patience...mais si je veux faire la même chose pour faire une copie xls de cette même feuille excel dans un autre dossier répertoire en même temps ?

Merci par avance

Bonjour,

Voici un code qui fait les 2 sauvegardes. A adapter

Sub Sauvegarde()
Application.ScreenUpdating = False
    Dim rng As Range, Chemin1, Chemin2, Choix As String
    Dim newWbk As Workbook, feuilCal As Worksheet, nomNewClasseur As String
    Choix = UCase(InputBox("Nom de la feuille à sauvegarder."))
    Set WsS = Worksheets(Choix)
    Set rng = WsS.Range("A1:D31") 'délimiter la sauvegarde
    S_Rep = "XXXXXXXXXX" 'Sous répertoire à créer éventuellement
    NomFichier = WsS.Range("D13") 
    Chemin1 = ThisWorkbook.Path & "\" & S_Rep & "\" 'répertoire à adapter
        If MsgBox("Voulez-vous sauvegarder cette feuille?", vbYesNo, "Information") = vbNo Then
            Exit Sub
        Else
        'Sauvegarde en pdf
            rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & NomFichier & ".pdf"
        'Sauvegarde en xlsx
        Chemin2 = ThisWorkbook.Path & "\" & S_Rep '& "\" 'répertoire à adapter
        'définir la feuille à copier
        Set feuilCal = ThisWorkbook.Sheets(Choix)
        'créer un nouveau classeur avec une seule feuille
        Set newWbk = Application.Workbooks.Add(xlWBATWorksheet)
        'copier les cellules de la feuille "XXXXX"
        feuilCal.Cells.Copy
         'coller les valeurs dans le nouveau classeur, puis les formats, puis les largeurs de colonnes
        newWbk.Sheets(1).Range("A1").PasteSpecial xlPasteValues
        newWbk.Sheets(1).Range("A1").PasteSpecial xlPasteFormats
        newWbk.Sheets(1).Range("A1").PasteSpecial xlPasteColumnWidths
            Application.CutCopyMode = False
        'récupérer le nom à donner au nouveau classeur
        nomNewClasseur = feuilCal.Range("D13") 
        'sauvegarder le classeur et le fermer
        newWbk.SaveAs Chemin2 & "\" & nomNewClasseur & ".xlsx"
        newWbk.Close
    MsgBox "Sauvegardes réussies."
End If
End Sub

cdt

Henri

Bonsoir Henri

Merci pour votre aide encore une fois. J'ai essayé de remplir les champs pour remplir les informations manquantes mais cela ne marche pas malgré tes efforts didactiques (j'en suis désolé d'ailleurs) :

Sub Sauvegarde()

Application.ScreenUpdating = False

Dim rng As Range, Chemin1, Chemin2, Choix As String

Dim newWbk As Workbook, feuilCal As Worksheet, nomNewClasseur As String

Choix = UCase(InputBox("Formulaire clients"))

Set WsS = Worksheets(Choix)

Set rng = WsS.Range("A1:K81") 'délimiter la sauvegarde

S_Rep = "XXXXXXXXXX" 'Sous répertoire à créer éventuellement

NomFichier = WsS.Range("D13")

Chemin1 = ThisWorkbook.Path & "C:\Users\ar...\OneDrive\Bureau\PDF clients\" & S_Rep & "\" 'répertoire à adapter

If MsgBox("Voulez-vous sauvegarder cette feuille?", vbYesNo, "Information") = vbNo Then

Exit Sub

Else

'Sauvegarde en pdf

rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & NomFichier & ".pdf"

'Sauvegarde en xlsx

Chemin2 = ThisWorkbook.Path & "C:\Users\ar...\OneDrive\Bureau\Xls clients" & S_Rep '& "\" 'répertoire à adapter

'définir la feuille à copier

Set feuilCal = ThisWorkbook.Sheets(Choix)

'créer un nouveau classeur avec une seule feuille

Set newWbk = Application.Workbooks.Add(xlWBATWorksheet)

'copier les cellules de la feuille "XXXXX"

feuilCal.Cells.Copy

'coller les valeurs dans le nouveau classeur, puis les formats, puis les largeurs de colonnes

newWbk.Sheets(1).Range("A1").PasteSpecial xlPasteValues

newWbk.Sheets(1).Range("A1").PasteSpecial xlPasteFormats

newWbk.Sheets(1).Range("A1").PasteSpecial xlPasteColumnWidths

Application.CutCopyMode = False

'récupérer le nom à donner au nouveau classeur

nomNewClasseur = feuilCal.Range("D13")

'sauvegarder le classeur et le fermer

newWbk.SaveAs Chemin2 & "\" & nomNewClasseur & ".xlsx"

newWbk.Close

MsgBox "Sauvegardes réussies."

End If

End Sub

Merci à vous.

Bonjour,

il faut créer le sous-répertoire

S_Rep = "XXXXXXXXXX" 'Sous répertoire à créer éventuellement

puis remplacer

Chemin1 = ThisWorkbook.Path & "C:\Users\ar...\OneDrive\Bureau\PDF clients\" & S_Rep & "\" 'répertoire à adapter

par

Chemin1 = ThisWorkbook.Path &  S_Rep & "\" 'répertoire à adapter

idem pour le Chemin2

Henri

Bonjour Henri

Je n'ai pas de sous répertoire prévu.

Le formulaire (ma feuille "Formulaire clients") que je veux sauvegarder simultanément en fichier pdf et fichier excel, vont aller dans des répertoires distincts : C:\Users\ar...\OneDrive\Bureau\PDF clients\ pour les pdf et C:\Users\ar...\OneDrive\Bureau\Xls clients\ pour les xls.

Essaie avec ce code

Sub Sauvegarde()
Application.ScreenUpdating = False
    Dim rng As Range, Chemin1, Chemin2 As String
    Dim newWbk As Workbook, feuilCal As Worksheet, nomNewClasseur As String
        Set WsS = Worksheets("Formulaire clients")
    Set rng = WsS.Range("A1:D31") 'délimiter la sauvegarde
     NomFichier = WsS.Range("D13") 
    Chemin1 = "C:\Users\ar...\OneDrive\Bureau\PDF clients & "\""  'répertoire à adapter
        If MsgBox("Voulez-vous sauvegarder cette feuille?", vbYesNo, "Information") = vbNo Then
            Exit Sub
        Else
        'Sauvegarde en pdf
            rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin1 & NomFichier & ".pdf"
        'Sauvegarde en xlsx
        Chemin2 = "C:\Users\ar...\OneDrive\Bureau\Xls clients & "\""  'répertoire à adapter
        'définir la feuille à copier
        Set feuilCal = ThisWorkbook.Sheets("Formulaire clients")
        'créer un nouveau classeur avec une seule feuille
        Set newWbk = Application.Workbooks.Add(xlWBATWorksheet)
        'copier les cellules de la feuille "XXXXX"
        feuilCal.Cells.Copy
         'coller les valeurs dans le nouveau classeur, puis les formats, puis les largeurs de colonnes
        newWbk.Sheets(1).Range("A1").PasteSpecial xlPasteValues
        newWbk.Sheets(1).Range("A1").PasteSpecial xlPasteFormats
        newWbk.Sheets(1).Range("A1").PasteSpecial xlPasteColumnWidths
            Application.CutCopyMode = False
        'récupérer le nom à donner au nouveau classeur
        nomNewClasseur = feuilCal.Range("D13") 
        'sauvegarder le classeur et le fermer
        newWbk.SaveAs Chemin2 & "\" & nomNewClasseur & ".xlsx"
        newWbk.Close
    MsgBox "Sauvegardes réussies."
End If
End Sub

Henri

Bonsoir Henri

Je te remercie encore une fois de ton aide...mais malheureusement le code ne fonctionne pas. Néanmoins je vais travailler sur une autre partie du code car celui sur lequel nous étions (enfin surtout toi) en train de travailler doit s'incorporer dans quelque chose de plus global donc je me dis qu'il faudra également adapter en fonction du reste. Je reposterai quand le moment sera venu.

Mais pour infos le message d'erreur indiqué arrive sur cette ligne :

Sub Sauvegarde()

Application.ScreenUpdating = False

Dim rng As Range, Chemin1, Chemin2 As String

Dim newWbk As Workbook, feuilCal As Worksheet, nomNewClasseur As String

Set WsS = Worksheets("Formulaire clients")

Set rng = WsS.Range("A1:D31") 'délimiter la sauvegarde

NomFichier = WsS.Range("D13")

Chemin1 = "C:\Users\ar...\OneDrive\Bureau\PDF clients & " \ "" 'répertoire à adapter