Enregistrer une feuille en Xlsm

Bonjour,

Bricoleuse du dimanche, je tente depuis quelque temps de modifier ce code.. en vain. J'utilise déjà ce code afin de pouvoir enregistrer "en off" des fichiers complétés par mes collaborateurs, cela me permet de capitaliser l'information sans qu'ils ne doivent penser à enregistrer leurs documents dans un dossier spécifique. Ce code me permet de récupérer les fichiers sous format .pdf ; j'aimerai aujourd'hui faire la même chose mais en récupérant la feuille sous format Xlsm. L'objectif est double : 1° me permettre de capitaliser l'information ; 2° permettre aux utilisateurs de mettre à jour leurs documents d'une année sur l'autre sans leur imposer de devoir tout recommencer.

Le code est le suivant : il me permet à la fois de renommer le fichier avec qq variables et de procéder à l'enregistrement auto dans le dossier informatique :

Sub Soumettre_Fiche_Reexamen()

Application.ScreenUpdating = False

' Création de variables
Dim nomFichier As String
Dim dateenr As String
Dim JJ As String
Dim MM As String
Dim AAAA As String

' Récupère la date du jour sur 3 cellules et la compil
JJ = Feuil3.Cells(1, 11).value
MM = Feuil3.Cells(1, 12).value
AAAA = Feuil3.Cells(1, 13).value
dateenr = AAAA & "-" & MM & "-" & JJ

' Création du nom du fichier avec compilation de la date du jour et éléments type nom, service ...
nomFichier = dateenr & "_" & Feuil3.Cells(12, 4).value & "_" & Feuil3.Cells(14, 4).value

' Enregistre sous format PDF avec le nom édité selon la saisie
Feuil3.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"ici_lien_du_dossier_informatique" & nomFichier & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
ActiveWorkbook.Save

Application.ScreenUpdating = True

End Sub

Je vous remercie par avance pour l'aide & les conseils que vous pourrez m'apporter :)

Bonjour,

Un fichier excel à chaque fois, ça peut faire beaucoup à la longue...

En tout cas, voici un essai avec un enregistrement double avec une seule procédure :

Sub Soumettre_Fiche_Reexamen()

Dim dateenr$, spath$, nomFichier$

dateenr = format(date, "YYYY-MM-DD") 'date du jour
spath = "ici_lien_du_dossier_informatique\" 'chemin <<<<<<<<<<

with Feuil3
    nomFichier = dateenr & "_" & .Cells(12, 4).value & "_" & .Cells(14, 4).value
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=spath & nomFichier & ".pdf", IgnorePrintAreas:=False
    .copy 'copie dans nouveau classeur
end with

ActiveWorkbook.close savechanges:=true, filename:=spath & nomFichier & ".xlsm"

End Sub

Cdlt,

Bonjour 3GB !

Merci pour ce premier essai, toutefois cela générait un msg d'erreur rendant impossible l'enregistrement :/
J'ai cherché par ailleurs et voici pour info qq chose qui fonctionne pour ce que je voulais faire :

Private Sub Bouton_Click()
Application.ScreenUpdating = False
Dim dateenr$, spath$, nomFichier$
Dim strThisOne As String
Dim strFile As String
Dim wbk As Workbook
dateenr = Format(Date, "YYYY-MM-DD") 'date du jour
spath = "Lien_dossier_informatique\"
With Feuil3
nomFichier = dateenr & "_" & .Cells(2, 9).Value & "_" & .Cells(2, 10).Value
End With
Set wbk = ActiveWorkbook
strThisOne = wbk.FullName
strFile = spath & nomFichier & ".xlsm"
Application.DisplayAlerts = False
wbk.Save
wbk.SaveAs Filename:=strFile
Application.DisplayAlerts = True
MsgBox "Le fichier a été archivé.", vbInformation
Shell "C:\WINDOWS\explorer.exe """ & spath & "", vbNormalFocus
Workbooks.Open strThisOne
wbk.Save
wbk.Close
Application.ScreenUpdating = True

End Sub

Merci encore !
Bonne journée

Bonjour Charlie,

Je pense que le code peut être allégé. A essayer :

Sub Soumettre_Fiche_Reexamen()

Dim dateenr$, spath$, nomFichier$

dateenr = format(date, "YYYY-MM-DD") 'date du jour
spath = "ici_lien_du_dossier_informatique\" 'chemin <<<<<<<<<< ADAPTER

with Feuil3
    nomFichier = dateenr & "_" & .Cells(2, 9).value & "_" & .Cells(2, 10).value
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=spath & nomFichier & ".pdf", IgnorePrintAreas:=False
    .copy 'copie dans nouveau classeur
end with

'application.displayalerts = false 'si besoin
with ActiveWorkbook
    .saveas filename:=spath & nomFichier & ".xlsm", fileformat:=xlOpenXMLWorkbookMacroEnabled
    .close true
end with
'application.displayalerts = true 'si désact.

MsgBox "Le fichier a été archivé.", vbInformation

End Sub

Au fait, pour poster du code, tu peux utiliser les balises </> du ruban d'icones.

Bonne journée,