Microsoft 365 Désactiver et réactiver l'enregistrement avec VBA

clad187

XLDnaute Nouveau
Bonjour à tous,

J'ai un fichier Excel qui est une fiche de renseignement vierge, que je souhaite garder en l'état sur le serveur de l'entreprise. J'ai donc interdit l'enregistrement avec une Macro dans ThisWorkbook.

Ce que je souhaite à présent, c'est pouvoir enregistrer mon fichier via une autre macro qui me propose un nom prédéfini avec l'ouverture automatique de la fenêtre enregistrer sous.

Je rencontre donc deux problèmes :
1. La macro "enregistrer sous" ne fonctionne pas puisque j'ai interdire l'enregistrement du fichier. Existe-t-il une commande pour autoriser l'enregistrement lors de l'exécution de cette macro?
2. Une fois mon fichier enregistré avec un nouveau nom, celui-ci doit pouvoir être librement utilisé par l'utilisateur. Sauf que ma macro d'interdiction persiste. Est-il possible d'interdire l'enregistrement de mon fichier uniquement si le nom du fichier est "Formulaire_vierge.xlsm", et que dès que la macro "enregistrer sous" ait été exécutée, le fichier ayant un nouveau nom, la macro ne soit plus active ?

A toute fin utile, je joins le fichier.

Merci par avance pour votre aide ! :)
 

Pièces jointes

  • Formulaire_vierge.xlsm
    15.1 KB · Affichages: 29

Staple1600

XLDnaute Barbatruc
Re, Bonjour Dranreb

=>clad187
Tu as testé la piste Workbooks.Add ?
(voir mon précédent message)
Le nouveau classeur porte un nom qui s'autoincrémente
modele1
modele2
etc...
Et donc le fichier initial( qui sert de modéle) n'est pas altéré.
Il suffit que celui-ci contienne un code proche de celui proposé par Dranreb pour que ce classeur s'enregistre avec un nom imposé et un chemin imposé.
 

Dranreb

XLDnaute Barbatruc
Si votre classeur est devenu un xltm essayez simplement en laissant dans ThisWorkbook :
VB:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
   Cancel = Me.FileFormat = xlOpenXMLTemplateMacroEnabled _
      Or Left$(Me.Name, 6) <> "TEXTE "
   End Sub
Et pour que cette procédure ne soit plus exécutée, dans Module1 :
VB:
Option Explicit
Sub Save_As()
   Dim ChNomF As Variant
   ChNomF = Application.GetSaveAsFilename("TEXTE " & ActiveSheet.[A1].Value, _
      "Classeur Excel avec macros,*.xlsm")
   If VarType(ChNomF) <> vbString Then Exit Sub
   If Left$(Mid$(ChNomF, InStrRev(ChNomF, "\") + 1), 6) <> "TEXTE " Then
      MsgBox ChNomF & vbLf & "Le nom du classeur doit commener par ""TEXTE """, _
         vbCritical, "Enregistrer sous"
      Exit Sub: End If
   ActiveSheet.[A1].Value = Split(Split(ChNomF, ".xlsm")(0), "\TEXTE ")(1)
   Application.EnableEvents = False
   ThisWorkbook.SaveAs ChNomF, xlOpenXMLWorkbookMacroEnabled
   Application.EnableEvents = True
   End Sub
 

bluesky12000

XLDnaute Junior
Bonjour à tous, je me permets de relancer cette discussion.

Si dans le nom du fichier enregistré, je fais référence à la cellule A1 qui est une date au format dd/mm/yyyy.

Je souhaiterais dans le nom du fichier enregistré garder uniquement yyyy, est-ce possible ?
J'ai essayé ActiveSheet.Range("A1").NumberFormat = "yyyy" mais cela ne fonctionne pas.

Merci beaucoup,
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Peu importe le format de cette cellule A1, si sa valeur est bien une date, et non un texte qui ne serait plus interprétable comme une date, vous pouvez concaténer Year(ActiveSheet.[A1].Value) dans l'expression du nom de fichier.
En changeant le format de cellule cela ne change pas son contenu ni sa valeur, mais seulement ce qu'elle affiche, à condition que ce soit numérique.
 
Dernière édition:

bluesky12000

XLDnaute Junior
Bonjour.
Peu importe le format de cette cellule A1, si c'est bien une date qu'elle contient, et non un texte qui ne serait plus interprétable comme une date, vous pouvez concaténer Year(ActiveSheet.[A1].Value) dans l'expression du nom de fichier.
Merci Dranreb pour ce retour si rapide cela fonctionne parfaitement :)
Entre temps, j'étais parti sur du Format(ActiveSheet.[A1].Value, "yyyy"),
 

Discussions similaires

Réponses
2
Affichages
416

Statistiques des forums

Discussions
311 735
Messages
2 082 023
Membres
101 873
dernier inscrit
excellllll