RESOLU - Sauvegarde forcée en XLSM

[olivepao]

Bonjour le forum

j'ai un petit problème avec ma sauvegarde forcée en XLSM.

Je sauve mon fichier dans un répertoire prédéfini, si je clique sur annuler lors de la première sauvegarde et que je je savegarde plus tard la sauvegarde forcée ne se fait plus en XLSM mais en XLSX. Comment faire pour que la sauvegarde forcée reste en XLSM ?

Public Repertoire As String
Public Sous_Rep_1 As String

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Sauve

Cancel = True

With Application.FileDialog(msoFileDialogSaveAs)
.InitialFileName = Sous_Rep_1 & "\"
.FilterIndex = 2
.AllowMultiSelect = False
.Show
End With

End Sub

Sub Sauve()

Repertoire = "I:\Toto"
Sous_Rep_1 = "I:\Toto\Toto_1"

Creation_Repertoire Repertoire

Application.EnableEvents = False

On Error Resume Next

Cancel = True

End Sub

Sub Creation_Repertoire(Repertoire As String)

If Dir(Repertoire, vbDirectory) = "" Then
    MkDir Repertoire
End If
   
If Dir(Sous_Rep_1, vbDirectory) = "" Then
    MkDir Sous_Rep_1
End If

End Sub

PS : le fichier de base est un modèle au dormat XLTM.


Merci de votre aide !

 

[Pierrot93]

Re : Sauvegarde forcée en XLSM

Bonjour,

petite remarque au passage, pas ouvert ton fichier, mais dans ta procédure "sauve", je ne vois pas trop à quoi servent ces 3 lignes :

Application.EnableEvents = False
On Error Resume Next
Cancel = True

elles me semblent inutiles.... enfin à première vue....

bon après midi
@+

 

[olivepao]

Re : Sauvegarde forcée en XLSM

Hello Pierrot93 hello les autres

En tout cas si Application.EnableEvents = False n'est pas présent dans la macro, tu n'arrive pas à enregistrer la macro.

Lorsque tu veux enregistrer le code, Excel ouvre (en boucle) la boite "Enregistrer sous"

Petit détail et non des moindre, l'instruction .Execute est manquante dans la macro de mon classeur. Voici le code modifié !

With Application.FileDialog(msoFileDialogSaveAs)
.InitialFileName = Sous_Rep_1 & "\"
.FilterIndex = 2
.AllowMultiSelect = False
.Show
.Execute
End With

Et avec tout ça je bute toujours . . .

A++

 

[olivepao]

Re : Sauvegarde forcée en XLSM

Hello tout le monde

Je pensait avoir trouver une solce en modifiant légèrement le code de ma macro sauve() mais
ce n'est pas encore vraiment ça !

si je veux enregistrer mon fichier, je dois cliquer 2x sur le bouton "Enregistrer" car le premeir clic n'a aucun effet.

Voilà la macro modifiée :

Sub Sauve()

Repertoire = "I:\Toto"
Sous_Rep_1 = "I:\Toto\Toto_1"

Creation_Repertoire Repertoire

With Application.FileDialog(msoFileDialogSaveAs)

.Title = "Veuillez enregistrer votre fichier au format XLSM !"
.InitialFileName = Sous_Rep_1 & "\"
.FilterIndex = 2
.InitialFileName = "Fichier_Toto"
.AllowMultiSelect = False

.Show

 If .SelectedItems.Count <> 1 Then
    Exit Sub
 End If
 
ActiveWorkbook.SaveAs Filename:=.SelectedItems(1)

.Execute

End With

 
Application.EnableEvents = False

On Error Resume Next

Cancel = True

End Sub

Si quelqu'un a une petite idée (une grande = je suis aussi preneur) . . .

Merci à tous et A++

 

[olivepao]

Re : NON RESOLU - Sauvegarde forcée en XLSM

Hello le forum

J'ai avancé quelque peu dans mes macros mais si j'ai réussi à rester sur le format XLSM lorsque je clique sur le bouton annuler, l'enregestrement du fichier ne se fait pas.

Voici le code modifié :

Public Repertoire As String
Public Sous_Rep_1 As String

----------------------------------

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Sauve

Cancel = True

End Sub

----------------------------------

Sub Sauve()

Repertoire = "I:\Toto"
Sous_Rep_1 = "I:\Toto\Toto_1"

Creation_Repertoire Repertoire

Set Enregistrement = Application.FileDialog(msoFileDialogSaveAs)
With Enregistrement
.Title = "Veuillez enregistrer votre fichier au format XLSM !"
.InitialFileName = Sous_Rep_1 & "\"
.FilterIndex = 2
.InitialFileName = "Fichier_Toto"
.AllowMultiSelect = False
.ButtonName = "Sauvez au format &XLSM"

If .Show <> 1 Then
    Exit Sub
Else
    Enregistrement.Show
    Enregistrement.Execute
End If

End With

Application.EnableEvents = False

On Error Resume Next

Cancel = True

End Sub

----------------------------------

Sub Creation_Repertoire(Repertoire As String)

If Dir(Repertoire, vbDirectory) = "" Then
    MkDir Repertoire
End If
   
If Dir(Sous_Rep_1, vbDirectory) = "" Then
    MkDir Sous_Rep_1
End If

End Sub

Je tourne toujour en rond, alors si une petite contribution vous dit . . .

PS : le fichier d'origine est au format XLTM

 

[olivepao]

Re : RESOLU - Sauvegarde forcée en XLSM

Hello le forum
Voici le code corrigé qui fonctionne :

Public Repertoire As String
Public Sous_Rep_1 As String
 
'----------------
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 
Sauve
 
Cancel = True
 
End Sub
 
'----------------
 
Sub Sauve()
 
Repertoire = "I:\Toto"
Sous_Rep_1 = "I:\Toto\Toto_1"
Dim Enregistrement As Office.FileDialog
Dim Mon_Fichier As String
 
Creation_Repertoire Repertoire
 
Set Enregistrement = Application.FileDialog(msoFileDialogSaveAs)
 
With Enregistrement
    Enregistrement.Title = "Veuillez enregistrer votre fichier au format XLSM !"
    Enregistrement.InitialFileName = Sous_Rep_1 & "\"
    Enregistrement.InitialFileName = "Toto-fichier"
    Enregistrement.FilterIndex = 2
    Enregistrement.AllowMultiSelect = False
    Enregistrement.ButtonName = "Sauvez au format &XLSM"
    Enregistrement.Show
 
    If .SelectedItems.Count = 1 Then
        On Error Resume Next
        Application.EnableEvents = False
        Enregistrement.Execute
        Application.EnableEvents = True
    Else
        Exit Sub
    End If
 
End With
 
Set Enregistrement = Nothing
 
Application.EnableEvents = False
 
End Sub
 
'----------------
 
Sub Creation_Repertoire(Repertoire As String)
 
If Dir(Repertoire, vbDirectory) = "" Then
    MkDir Repertoire
End If
 
If Dir(Sous_Rep_1, vbDirectory) = "" Then
    MkDir Sous_Rep_1
End If
 
End Sub

Malgré la maigre contribution du forum, j'espère que ce code (pour lequel on m'a aidé) vous sera utile.