Forcer un 'save as' en VBA

Le 28/12/2016 à 13:48

Bonjour le forum,

Je suis à la recherche d'une routine VBA qui empêche de sauver un fichier avec le même nom et force un enregistrement sous.

Cordialement

Le 28/12/2016 à 16:07

Bonjour

J'ai trouvé cela sur le web, j'ai pas tout compris mais ça marche.....

Sub sbSaveExcelDialog()

Dim IntialName As String

Dim sFileSaveName As Variant

ChDir ActiveWorkbook.Path

InitialName = ActiveWorkbook.Name 'nom souhaité pour le fichier ?

sFileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitialName, fileFilter:="Excel Files (*.xlsm), *.xlsm")

If sFileSaveName <> False Then

ActiveWorkbook.SaveAs sFileSaveName

Else

ActiveWorkbook.Save

End If

End Sub

Le 28/12/2016 à 16:15

Bonjour,

Une piste

j'ai trouvé ce bout de code réalisé par MichDenis :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Z As String
    If SaveAsUI = True Then
    Else
        Do
        Z = Application.InputBox(PROMPT:="Inscrivez le NOUVEAU nom du classeur.", _
        Title:="Enregistrer sous", Default:="SonNom.xls", Type:=2)
        If Format(Z) = False Then Cancel = True: Exit Sub
            If LCase(Right(Z, 4)) <> ".xlsm" Then Z = Z & ".xlsm"
                If UCase(Z) = UCase(ThisWorkbook.Name) Then
                    If MsgBox("Ce nom existe déjà. Vous devez choisir un autre nom." & _
                    "Désirez-vous continuer?", vbCritical + vbYesNo, "Nouveau nom") = vbNo Then
                    Cancel = True
                    Exit Sub
                End If
            Else
                On Error Resume Next
                Application.EnableEvents = False
                ThisWorkbook.SaveAs ThisWorkbook.Path & "" & Z
                Application.EnableEvents = True
                    If Err <> 0 Then
                        Err.Clear
                        MsgBox "Vous avex saisi un caractère interdit dans " & _
                        "le nom du fichier : |/*?:><"
                        Cancel = False
                    Else
                        Cancel = True
                    End If

            End If
        Loop Until Cancel = True
    End If
End Sub

Sur une ancienne version d'Excel (je ne l'ai pas testée)

Le 28/12/2016 à 17:45

Bonjour

Code très complet, mais le nom du fichier à enregistrer n'est pas comparé aux fichiers existants dans le répertoire voulu....

Pour ce que je comprends, cette procédure compare le nouveau nom au nom du classeur ouvert qui doit être enregistré...

Cela doit être simple......pour les bons !

Je vais continuer à chercher

FINDRH

Le 28/12/2016 à 20:42
FINDRH a écrit :

Bonjour

J'ai trouvé cela sur le web, j'ai pas tout compris mais ça marche.....

Sub sbSaveExcelDialog()

Dim IntialName As String

Dim sFileSaveName As Variant

ChDir ActiveWorkbook.Path

InitialName = ActiveWorkbook.Name 'nom souhaité pour le fichier ?

sFileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitialName, fileFilter:="Excel Files (*.xlsm), *.xlsm")

If sFileSaveName <> False Then

ActiveWorkbook.SaveAs sFileSaveName

Else

ActiveWorkbook.Save

End If

End Sub

Bonsoir FINDRH,

Cela ne fonctionne malheureusement pas...

ouisansdoute a écrit :

Bonjour,

Une piste

j'ai trouvé ce bout de code réalisé par MichDenis :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Z As String
    If SaveAsUI = True Then
    Else
        Do
        Z = Application.InputBox(PROMPT:="Inscrivez le NOUVEAU nom du classeur.", _
        Title:="Enregistrer sous", Default:="SonNom.xls", Type:=2)
        If Format(Z) = False Then Cancel = True: Exit Sub
            If LCase(Right(Z, 4)) <> ".xlsm" Then Z = Z & ".xlsm"
                If UCase(Z) = UCase(ThisWorkbook.Name) Then
                    If MsgBox("Ce nom existe déjà. Vous devez choisir un autre nom." & _
                    "Désirez-vous continuer?", vbCritical + vbYesNo, "Nouveau nom") = vbNo Then
                    Cancel = True
                    Exit Sub
                End If
            Else
                On Error Resume Next
                Application.EnableEvents = False
                ThisWorkbook.SaveAs ThisWorkbook.Path & "" & Z
                Application.EnableEvents = True
                    If Err <> 0 Then
                        Err.Clear
                        MsgBox "Vous avex saisi un caractère interdit dans " & _
                        "le nom du fichier : |/*?:><"
                        Cancel = False
                    Else
                        Cancel = True
                    End If

            End If
        Loop Until Cancel = True
    End If
End Sub

Sur une ancienne version d'Excel (je ne l'ai pas testée)

Bonsoir ouisansdoute,

Merci pour ce code qui fonctionne à moitié.

C'est un bon début !

FINDRH a écrit :

Bonjour

Code très complet, mais le nom du fichier à enregistrer n'est pas comparé aux fichiers existants dans le répertoire voulu....

Pour ce que je comprends, cette procédure compare le nouveau nom au nom du classeur ouvert qui doit être enregistré...

Cela doit être simple......pour les bons !

Je vais continuer à chercher

FINDRH

Cher/Chère FINDH,

La routine démarre au bon moment et permet effectivement d'enregistrer sous un nouveau nom.

Par contre, pas dans le bon répertoire et, je ne sais pas pourquoi, en ajoutant "download" en début de nom de fichier.

Lorsqu'on utilise un mauvais caractère, là encore, cela fonctionne correctement.

Par contre, lorsqu'on souhaite enregistrer une seconde fois le fichier, il permet d'écraser la sauvegarde précédente.

Je me débrouille en VBA mais là, je coince.

Merci d'avance si vous avez encore un peu de temps à y consacrer...

Le 28/12/2016 à 21:42

Bonsoir

avec une adaptation des sources Boisgontier , ci joint une procédure qui marche chez moi :

Sub enrsous()

ChDir ActiveWorkbook.Path ' chemin critique

Vclas = ActiveWorkbook.Name ' nom du classeur ouvert

repertoire = ThisWorkbook.Path & "\" ' adapter

Vn = Dir(repertoire & "*.*") 'premier fichier

Do While Vn <> ""

If Vn = Vclas Then' nom existe dans repertoire

sNomFicha = "Changer nom" 'apparait dans nom a saisir, on peut mettre n'importe quoi

' bt dialogue pour saisir nouveau nom

sNomFich = Application.GetSaveAsFilename(InitialFileName:=sNomFicha, fileFilter:="Excel Files (*.xlsm), *.xlsm")

If sNomFich <> False Then' teste si nom vide

ActiveWorkbook.SaveAs sNomFich' enregistre avec le nom saisi

Else ' cilic sur annuler

MsgBox (" pas de nouveau nom de fichier saisi")

Exit Sub' sort de la procédure

End If

Exit Sub

Else

End If

Vn = Dir ' suivant

Loop

ActiveWorkbook.Save ' enregistrement classique

End Sub

Curieux de voir si ça marche

Cordialement

M. FINDRH !!! sans susceptibilité !!!

Le 28/12/2016 à 22:00

Bonsoir,

Il faut être conscient que ta procédure une fois en place interdira tout enregistrement du classeur, il ne pourra plus être enregistré que sous un autre nom. Et chaque nouvel enregistrement sous un autre nom ne pourra à son tour être enregistré que sous un autre nom nouveau...

Remarque, tu pourra alterner avec deux noms, rien ne l'interdira...

Les réponses que tu as eues devraient te permettre de définir la procédure que tu souhaites :

  • L'évènement BeforeSave est à programmer pour intercepter la demande d'enregistrement et l'empêcher ; dans tous les cas, Cancel devra être mis à True pour empêcher l'enregistrement normal.
  • La méthode GetSaveAsFilename est elle-aussi tout indiquée pour demander à l'utilisateur d'indiquer un nom, en lui suggérant un nom qui ne soit pas celui du classeur bien sûr et en vérifiant que son choix ne rétablit pas le nom du classeur.
La vérification faite, il suffira alors de l'enregistrer sous ce nom avec SaveAs (l'enregistrement n'est pas automatique).

Cordialement.

Le 29/12/2016 à 10:25

Cher M. FINDRH,

Encore merci pour ton aide.

Dans le fichier ci-dessous, j'ai inséré ton dernier code dans une routine BeforeSave.

70forcesaveas-01.xlsm (13.96 Ko)

Au moment d'enregistrer le fichier (Save ou Close / Save), cela ouvre une fenêtre SaveAs avec un nouveau nom et dans le même répertoire. Youhou !

Cela dit,

  • Si tu cliques sur [enregistrer], la fenêtre SaveAS s'ouvre à nouveau ! Et là, tu peux l'enregistrer.
  • Si tu lui donnes l'ancien nom du fichier, la fenêtre SaveAS s'ouvre à nouveau et, si tu réessayes encore, il est alors possible d'écraser le fichier !
  • Je n'ai pas pu déterminer les circonstances exactes mais il est arrivé qu'Excel se plante avec le message "Microsoft Excel attend la fin de l'exécution d'une action OLE d'une autre application."
  • Si tu cliques sur [Annuler] de la fenêtre SaveAs, la boîte de dialogue s'affiche mais le fichier est enregistré avec l'ancien nom !

Qu'en penses-tu ?

Le 30/12/2016 à 10:52

Bonjour

j'ai atteint mes limites de compréhension...... mais je pense que before save avec un save ensuite, ça boucle...... et on pourra toujurs écraser le fichier par forçage.....

Maintenant je redescends sur terre avec une proposition basique qui ne résoud pas tout :

- si tu enregistres ton fichier de base sous Modèle

-quand tu l'ouvres son nom s’incrémente automatiquement

- quand tu l’enregistres tu peux changer de nom

mais pour écraser l'original, il faut faire enregistrer sous modèle et remettre le nom original,

rechoisir le bon répertoire car dans ce cas c'est le répertoire modèle dans c qui t'est proposé.....

Désolé.....

Findrh

Le 30/12/2016 à 17:20

Bonsoir,

Je savais que cette question était ardue.

Cela dit, ta suggestion est très intéressante et je n'y avais évidemment pas pensé.

Bonne année et merci quand-même !

Rechercher des sujets similaires à "forcer save vba"