Problème d'enregistrement d'un fichier en xlsm en VBA

Bonjour à tous,

J'ai mis en place la macro suivante qui fait appel à différentes "sous-macros" avec l'aide de GYRUS pour certains codes :

Sub Confirmation_enregistrement()
'Demande confirmation pour lancer la procédure d'enregistrement
Select Case MsgBox("Êtes-vous sûr de vouloir enregistrer ce devis ?", vbYesNo, "Enregistrement")

Case vbYes
' Procédure si click sur Oui
'Combine dans l'ordre les macros suivantes
Call Refus_enregistr
If Worksheets("PROPOSITION").Cells(9, 14).Value <> "SVP : Identifiez-vous !" Then
Call ActiveCounter
Call Copier_enregistr_DEVIS_XLSM
ActiveWorkbook.Close True
Call Copier_enregistr_DEVIS_PDF
ActiveWorkbook.Close True
End If
Call Mise_à_blanc_DEVIS
Case vbNo
'procédure si click sur Non
End Select
End Sub

Cette macro vérifie en premier que l'utilisateur soit enregistré et si oui :
- incrémente un compteur
- crée et enregistre une copie de la feuille active en nommant cette copie selon le contenu de la case A1 et en .xlsm
- ferme cette copie,
- crée et enregistre une autre copie de la feuille active en nommant cette copie selon le contenu de la case A2 et en .pdf
- ferme cette 2ème copie,
- effectue une mise à blanc des informations saisies dans la feuille active.

Cette macro fonctionne correctement sauf la sous-macro enregistrement en xlsm.

Voici cette sous-macro :

Sub Copier_enregistr_DEVIS_XLSM()
Application.EnableEvents = False
ThisWorkbook.Worksheets("PROPOSITION").Copy
With ActiveWorkboock
'suppression des boutons de commande : ne supprime que les boutons de commande pas les photos
For Each s In ActiveSheet.Shapes
'Bouton "Changer de véhicule"
If s.TopLeftCell.Address = "$J$12" Then
s.Delete
End If
Next s
'Forme BLANCHE masquant "caractéristiques techniques du véhicule" sous les boutons
For Each s In ActiveSheet.Shapes
If s.TopLeftCell.Address = "$I$12" Then
s.Delete
End If
Next s
'Boutons "Enregistrer DEVIS", "NOUVEAU DEVIS", "QUITTER"
For Each s In ActiveSheet.Shapes
If s.TopLeftCell.Address = "$N$12" Then
s.Delete
End If
Next s
For Each s In ActiveSheet.Shapes
' Bouton "NV"
If s.TopLeftCell.Address = "$R$8" Then
s.Delete
End If
Next s

'Suppression des formules
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Cells(1, 1).Select


'definition du nom du fichier POUR ENREGISTREMENT XLSM
NomDeSauvegarde = ActiveWorkbook.Sheets("PROPOSITION").Range("A1").Text

'efface les données contenues dans les cases "A1","A2","G3", ....
Sheets("PROPOSITION").Range("A1,A2,G3,H3,H7,M3,N1,N3,N4,P7").ClearContents

'enregistre la copie en XLSM sous le nom contenu dans la cellule A1 de la feuille "PROPOSITION" du fichier Source à un
'emplacement choisi par l'utilisateur
NomSauve = ActiveWorkbook.Application.GetSaveAsFilename(InitialFileName:=NomDeSauvegarde, _
FileFilter:="Classeur Excel(*.xlsm), *.xlsm")
If NomSauve = False Then Exit Sub

ActiveWorkbook.SaveAs NomDeSauvegarde = NomSauve
End With

Application.EnableEvents = True
Exit Sub

End Sub

Cette sous-macro fonctionne bien sauf la partie enregistrement :

- la boite de dialogue "Enregistrer sous" s'ouvre correctement :
- le nom de fichier proposé est bien celui qui figure dans la case A1,
- l'extension est correcte me semble-t-il : Classeur EXCEL (.xlsm)
- mais lorsque je confirme l'enregistrement, elle me créé un fichier FALSE.xslm et un deuxième fichier du style Classeur22.xslx.

J'ai trouvé sur un site une extension à apporter après le NomSauve dans la ligne "ActiveWorkbook.SaveAs NomDeSauvegarde = NomSauve" :" , FileFormat:=xlOpenXMLWorkbookMacroEnabled" mais cela ne change rien. Je sais juste que ce dernier format permet d'éviter des conflits d'ouverture dans les différentes versions d'Excel si j'ai bien compris.

Après quelques échanges avec GYRUS sur ce point et après y avoir passé encore une bonne partie de l'après-midi je désespère !!! Au secours !!!

Quelqu'un aurait-il une explication sur ce qui ne fonctionne pas dans cette partie de code et une solution ??

J'espère que quelqu'un pourra s'interesser à ce problème et je l'en remericie d'avance.

Désolé de la longueur mais au moins vous avez tous les éléments. Je travaille sous Excel 2010 mais le fichier doit pouvoir fonctionner avec des versions plus anciennes et plus récentes.

BING02