XL 2013 (RESOLU) Modification du code de pdf au xlsm

chaelie2015

XLDnaute Accro
Bonjour Forum
VB:
Sub Enregistrer_Copie()
 Dim NomFichierEXCEL As String
 Dim Nom As String
  
 Nom = Range("M2").value

 NomFichierEXCEL = "Evaluation CEO-" & Nom & ".xlsm"
 NomFichierEXCEL = ThisWorkbook.Path & "\" & NomFichierEXCEL
 NomFichier = Split(NomFichierEXCEL, "\")(UBound(Split(NomFichierEXCEL, "\")))
 
 If Dir(NomFichierEXCEL) <> "" Then
  If MsgBox("Le fichier EXCEL " & NomFichier & " existe déjà. Voulez-vous le remplacer ?", vbYesNo + vbQuestion) = vbNo Then
   Exit Sub
  End If
 End If
 
 ActiveSheet.ExportAsFixedFormat Type:=xlTypexlsm, Filename:=NomFichierEXCEL, Quality:=xlQualityStandard
 MsgBox "Un nouveau fichier EXCEL nommé " & vbCrLf & vbCrLf & NomFichier & vbCrLf & vbCrLf & " a été enregistré dans le répertoire " & vbCrLf & vbCrLf & ThisWorkbook.Path & "."
 
 End Sub
Ce code est conçu pour être associé à un bouton dans ma feuille de calcul 'Récap'. Lorsqu'il est exécuté, il prend le nom de la cellule M2 comme base pour nommer le nouveau fichier , enregistre ce fichier dans le même répertoire que le classeur actif, et informe l'utilisateur du résultat de l'opération.
Malheureusement, il enregistre le fichier au format PDF, mais ce que je souhaite, c'est l'enregistrer au format .xlsm, c'est-à-dire en tant que classeur Excel complet.
merci
 
Solution
Bonjour chaelie2015,

Pour créer une sauvegarde utilisez SaveCopyAs :
VB:
Sub Enregistrer_Copie()
Dim nom$, fichier$
nom = "Evaluation CEO-" & Sheets("Récap").[M2] & ".xlsm"
fichier = ThisWorkbook.Path & "\" & nom
If Dir(fichier) <> "" Then If MsgBox("Le fichier EXCEL '" & nom & "' existe déjà. Voulez-vous le remplacer ?", vbYesNo + vbQuestion) = vbNo Then Exit Sub
ThisWorkbook.SaveCopyAs fichier
MsgBox "Un nouveau fichier EXCEL nommé " & vbCrLf & vbCrLf & nom & vbCrLf & vbCrLf & " a été enregistré dans le répertoire " & vbCrLf & vbCrLf & ThisWorkbook.Path & "."
End Sub
fonctionnera si en M2 il n'y a pas de caractères interdits.

A+

job75

XLDnaute Barbatruc
Bonjour chaelie2015,

Pour créer une sauvegarde utilisez SaveCopyAs :
VB:
Sub Enregistrer_Copie()
Dim nom$, fichier$
nom = "Evaluation CEO-" & Sheets("Récap").[M2] & ".xlsm"
fichier = ThisWorkbook.Path & "\" & nom
If Dir(fichier) <> "" Then If MsgBox("Le fichier EXCEL '" & nom & "' existe déjà. Voulez-vous le remplacer ?", vbYesNo + vbQuestion) = vbNo Then Exit Sub
ThisWorkbook.SaveCopyAs fichier
MsgBox "Un nouveau fichier EXCEL nommé " & vbCrLf & vbCrLf & nom & vbCrLf & vbCrLf & " a été enregistré dans le répertoire " & vbCrLf & vbCrLf & ThisWorkbook.Path & "."
End Sub
fonctionnera si en M2 il n'y a pas de caractères interdits.

A+
 

Discussions similaires

Statistiques des forums

Discussions
312 803
Messages
2 092 257
Membres
105 318
dernier inscrit
alberic63