Sauvegarder sous sans modifier mon classeur

Bonjour,

Je voudrais, à l'aide de cette macro, enregistrer-sous en format pdf mon document. Le nom du pdf aurait comme préfixe "Bloc A" et serait incrémenter de 1 à chaque sauvegarde (pour avoir un suivi de ces pdf). J'ai réussi à faire cette sauvegarde et l'incrémentation mais mon problème est que lorsque j'exécute ma macro mon fichier de base (que je veux enregistrer mais pas modifier) ce modifie. J'obtiens donc mon pdf qui est bon mais mon fichier Excel qui doit rester inchangé est modifié.

Une idée pour éviter cette modification ?

Voici le code que j'ai fais :

Sub EnregistrerBlocA()
ThisWorkbook.Save
Application.DisplayAlerts = False
Dim chemin$, racine$, fichier$, maxi%
Dim mafeuille As Worksheet

For Each mafeuille In ThisWorkbook.Worksheets
    If mafeuille.Name <> ThisWorkbook.ActiveSheet.Name Then
        mafeuille.Delete
    End If
Next mafeuille

chemin = "J:\24 - Amélioration Continue - CI\Fiche vie Outillage\Archives\fiche de vie sinteco ancienne\BLOC A\"
racine = "Bloc A"
fichier = Dir(chemin & racine & "*.xlsm") '1er fichier du dossier
While fichier <> ""
    If fichier Like racine & "#*.xlsm" Then _
        If Val(Mid(fichier, Len(racine) + 1)) > maxi Then maxi = Val(Mid(fichier, Len(racine) + 1))
    fichier = Dir 'fichier suivant
Wend

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
chemin & racine & Format(maxi + 1), Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
From:=1, To:=1, OpenAfterPublish:=True

End Sub

Bonjour,

Tu prends le problème dans le mauvais sens : tu supprimes toutes tes feuilles puis ensuite l'enregistre sous via l'export.

Il ne faut pas cette partie de code :

For Each mafeuille In ThisWorkbook.Worksheets
    If mafeuille.Name <> ThisWorkbook.ActiveSheet.Name Then
        mafeuille.Delete
    End If
Next mafeuille

Joint nous un fichier type et nous te ferons la macro si tu n'y arrives pas.

Bonne soirée !

Bonjour à tous,

Je suis d'accord avec Ergotamine, la suppression de feuilles ne semble pas nécessaire surtout si vous n'en copiez qu'une.

Voici une proposition de code en attendant un éventuel fichier où je pars du principe (si j'ai bien compris) que les noms de fichiers sont Bloc A #.xlsm avec # un nombre sans rien derrière :

Sub EnregistrerBlocA()

Dim dossier$, racine$, fichier$, chemin$, maxi%

ThisWorkbook.Save
dossier = "J:\24 - Amélioration Continue - CI\Fiche vie Outillage\Archives\fiche de vie sinteco ancienne\BLOC A\"
racine = "Bloc A"

fichier = Dir(dossier & racine & "*.xlsm") '1er fichier du dossier
While fichier <> ""
    If fichier Like racine & "#*.xlsm" Then
        maxi = replace(replace(fichier, racine, ""), ".xlsm", "") + 1
    end if
    fichier = Dir 'fichier suivant
Wend

chemin = dossier & racine & maxi

with ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin, IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=True
    .copy
end with

activeworkbook.saveas chemin, xlOpenXMLWorkbookMacroEnabled

End Sub

Cdlt,

Bonjour,

@3GB : Tu as travaillé tard hier :)

Je comprend bien ton code mais toujours pas le lien d'une certaine partie avec le besoin de l'auteur. Pourquoi enregistrons-nous le xlsm sous le nom incrémenté alors que de ce que j'ai compris il ne s'agit QUE d'un export PDF incrémenté dont il a besoin.

@Pepiteau : Pourrais-tu nous repréciser ton besoin afin que nous l’interprétions correctement ? En nous joignant un fichier ce sera encore mieux.

Merci !

Bonjour Ergotamine,

C'est une bonne remarque ! Comme tu l'as constaté, il était tard alors j'ai peut-être fait n'importe quoi .

Mais si j'ai fait la sauvegarde, c'est parce que le début du code sonde un dossier avec tous les fichiers "Bloc A...xslm". Comme c'est à partir de ça qu'on incrémente, j'ai supposé qu'il fallait créer un nouveau fichier...

Mais il est vrai que ce n'est pas ce que Pepiteau a formulé dans sa demande.

Mais qui peut le plus peut le moins.

Cdlt,

Bonjour,

Comme tu l'as vu dans mes réponses, je fais souvent le moins

Passe une bonne journée de codage !

Bonjour,

Tout d'abord merci de vos réponses. @Ergotamine pour essayer d'être plus précis, j'aimerais que la macro enregistre la feuille sur laquelle on est en format pdf dans un dossier précis. Quant au classeur dans lequel on est, celui-ci reste inchangé.

Je vais tester vos codes voir s'ils vont, je vous remercie encore tous les deux

En modifiant légèrement le code de @3GB j'ai réussi à faire ce que je voulais.

J'ai juste supprimer 2 lignes qui enregistrait un autre tableau en plus du pdf voulu et j'ai modifié la boucle while pour que l'incrémentation prenne en compte les fichiers pdf au lieu de xlsm (c'était une erreur de ma part)

Je vous remercie de votre aide et vous souhaite une bonne journée

Sub EnregistrerBlocA()

Dim dossier$, racine$, fichier$, chemin$, maxi%

ThisWorkbook.Save
dossier = "J:\24 - Amélioration Continue - CI\Fiche vie Outillage\Archives\fiche de vie sinteco ancienne\BLOC A\"
racine = "Bloc A"

fichier = Dir(dossier & racine & "*.pdf") '1er fichier du dossier
While fichier <> ""
    If fichier Like racine & "#*.pdf" Then
        maxi = Replace(Replace(fichier, racine, ""), ".pdf", "")
    End If
    fichier = Dir 'fichier suivant
Wend

chemin = dossier & racine & maxi + 1

With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin, IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=True
    '.Copy
End With

'ActiveWorkbook.SaveAs chemin, xlOpenXMLWorkbookMacroEnabled

End Sub

Merci de ce retour !

Oui, c'est ce que je m'étais dit (pour l'extension). C'était probablement la meilleure chose à faire.

Très bonne journée à vous aussi,

Cdlt,