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

Fermé
BING02 - 12 mars 2015 à 18:31
cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 - 14 mars 2015 à 10:00
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

A voir également:

3 réponses

cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
12 mars 2015 à 19:00
Bonjour,

voici une sauvegarde en xlsm:

Sub sauvegarder()
    Dim extension As String
    Dim chemin As String
    Dim nomfichier As String
    extension = ".xlsm"
    chemin = "C:\chemin\"
    nomfichier = ActiveSheet.Range("A1") & extension
With ActiveWorkbook
      .SaveAs Filename:=chemin & nomfichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
      End With
    End Sub

0
Bonjour,
Merci beaucoup. Je ne doute pas qu'elle fonctionne mais dans mon cas précis je ne sais pas comment l'intégrer dans ma procédure globale.
Pourrais-tu m'aider ?
D'avance merci
BING02
0
cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
13 mars 2015 à 17:32
comme ceci:

A la place de cela

'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 


ceci:

'emplacement choisi par l'utilisateur 
NomSauve = ActiveWorkbook.Application.GetSaveAsFilename(InitialFileName:=NomDeSauvegarde, _
FileFilter:="Classeur Excel(*.xlsm), *.xlsm")
ActiveWorkbook.SaveAs Filename:=NomSauve, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False


Voilà

0
Bonsoir,

Super !!! Merci beaucoup pour ton aide. J'ai encore un autre petit souci malgré tout. Cette macro m'enregistre bien la copie XLSM mais elle me crée un classeur supplémentaire dont je n'ai pas besoin. Je ne comprends pas d'où sort ce classeur qui lui n'est pas en XLSM (il est en XSLX) et qui n'est pas traité par la macro générale puisqu'il n'est pas fermé à la fin.

Aurais-tu une idée ??? Je pense que c'est dans ma macro d'enregistrement en XLSM d'autant que qu'en j'exécute cette macro toute seule le phénomène se produit bien aussi. Cette macro est donc maintenant comme suit :



Je la lis et je la relis mais je ne comprends pas ??? Mystère.
Merci d'avance et bonne soirée.
0
Bonsoir,
J'ai l'impression que ma macro ne s'est pas insérée dans la carré gris (j'ai tenté pour la première fois car je ne suis pas un grand spécialiste de la chose et çà se confirme !!) alors je l'insère normalement !!

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 macros
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
.DeleteLines 1, .CountOfLines
End With

'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")

ActiveWorkbook.SaveAs Filename:=NomSauve, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End With

Application.EnableEvents = True
Exit Sub

End Sub

Bonsoir et merci encore pour ton aide
BING02
0
cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
14 mars 2015 à 10:00
Apprends-toi a mettre Option Explicit au début de ton code, tu verras alors les erreurs que tu as:
With ActiveWorkboock avec un c en trop
NomSauve et NomDeSauvegarde variables qui ne sont pas déclarées
Voici le code qui fonctionne très bien et qui ne m'enregistre aucun autre fichier que le xlsm!

Option Explicit
Private Sub CommandButton1_Click()
Copier_enregistr_DEVIS_XLSM
End Sub
Sub Copier_enregistr_DEVIS_XLSM()
Dim NomDeSauvegarde, NomSauve
Application.EnableEvents = False
ThisWorkbook.Worksheets("PROPOSITION").Copy
With ActiveWorkbook
'suppression des macros
 With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
 .DeleteLines 1, .CountOfLines
 End With
'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")
ActiveWorkbook.SaveAs Filename:=NomSauve, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End With
Application.EnableEvents = True
'Exit Sub'cela n'est pas necessaire puisque l'on est à la fin
End Sub

0