Ouverture menu enregistrer sous

Version imprimable

15/05/2013, 12h12
havopti

Ouverture menu enregistrer sous
Salut a tous

j'ai une macro qui empêche de sauvegarder un fichier si celui correspond au mon chemin cible, le but était d’éviter d'utiliser la lecture seule.
Code:

1 2 3 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If ThisWorkbook.FullName = "chemin cible" Then Cancel = True End Sub
hors avec ceci j’obtiens parfaitement ce que je veux c'est à dire qu'il est impossible de sauvegarder des modifications sur se fichier, je voudrais juste ajouter lorsque que l'on quitte le fichier une ouverture du menu enregistrer sous afin que des utilisateurs maladroits qui ont fait des modifications sur le fichier sans faire attention puisse tout de meme sauver leurs travail en faisant une copie.

comme ceci?

Code:

1
2
3
4
Private Sub Workbook_Deactivate()
Application.Dialogs(xlDialogSaveAs).Show
 
End Sub

15/05/2013, 14h22
havopti

merci pour ton code, ca marche tres bien sur un fichier test sans aucune autre macro.

Cependant placé dans le code avec le fichier sur lequel il est impossible de faire une sauvegarde ça ne marche pas. La boite de dialogue ne s'ouvre pas :?

Bonsoir,

rajoute une variable autoriseEnregistrement mis à true lors de ton Desactivate...
et conditionne ensuite le "Cancel" avec cette variable:
Code:

1 2 3 4 5 6 Option Explicit Dim AutoriseEnregistrement as boolean Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If ThisWorkbook.FullName = "chemin cible" Then Cancel = Not AutoriseEnregistrement End Sub

Ce code me permet de créer une sauvegarde via enregistrer sous mais je n'arrive pas a modifier le chemin d'enregistrement pour qu'il propose mes documents
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Option Explicit Private BeforeClosing As Boolean Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If Not BeforeClosing Then If ThisWorkbook.FullName = "chemin cible.xlsm" Then Cancel = True End If BeforeClosing = False End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) BeforeClosing = True ChDrive ("C") ChDir ("\chemin d'enregistrement") Application.Dialogs(xlDialogSaveAs).Show End Sub
Citation:
Envoyé par bbil
Bonsoir,

rajoute une variable autoriseEnregistrement mis à true lors de ton Desactivate...
et conditionne ensuite le "Cancel" avec cette variable:
Code:

1 2 3 4 5 6 Option Explicit Dim AutoriseEnregistrement as boolean Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If ThisWorkbook.FullName = "chemin cible" Then Cancel = Not AutoriseEnregistrement End Sub
c'est à dire? je suis pas un pro de vba donc 8O

Bonjour,

et comme ceci?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 If ThisWorkbook.FullName = "C:\Documents and Settings\---------------\Mes documents\Classeur1.xlsm" Then
 
 MsgBox "Vous ne pouvez pas enregistrer sur le fichier de base: " & ThisWorkbook.Name
 
End If
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If ThisWorkbook.FullName = "C:\Documents and Settings\---------------\Mes documents\Classeur1.xlsm" Then
    Application.DisplayAlerts = False
    MsgBox "blabla.." 'facultatif
    Application.Dialogs(xlDialogSaveAs).Show
    Application.Quit
    End If
End Sub

Après réflexion :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Option Explicit
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 
  If IndicateurFermeture = False Then
 
    IndicateurFermeture = True
 
Dim Msg, style, Title, Help, Ctxt, Response, MyString, Mystre
    Msg = "Vous ne pouvez pas enregistrer sur le fichier de base!" & vbCrLf & vbCrLf & _
    "Par contre vous pouvez l'enregitrer dans le dossier et avec le nom de votre choix " & vbCrLf & _
    "Le souhaitez-vous ?" ' Définit le message.
    style = vbYesNo + vbCritical + vbDefaultButton3 ' Définit les boutons.
    Title = "Sélectionner le bouton correspondant "  ' Définit le titre.
    Help = "DEMO.HLP"   ' Définit le fichier d’aide.
    Ctxt = 1000 ' Définit le contexte de la rubrique.
          ' Affiche le message.
    Response = MsgBox(Msg, style, Title, Help, Ctxt)
 
 
    If Response = vbYes Then
    Application.DisplayAlerts = False
    Application.Dialogs(xlDialogSaveAs).Show
    End If
 If ThisWorkbook.FullName = "C:\Documents and Settings\---------------\Mes documents\Classeur1.xlsm" Then IndicateurFermeture = False
 If ThisWorkbook.FullName <> "C:\Documents and Settings\---------------\Mes documents\Classeur1.xlsm" Then IndicateurFermeture = True
End If
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If ThisWorkbook.FullName = "C:\Documents and Settings\---------------\Mes documents\Classeur1.xlsm" Then
    'Application.DisplayAlerts = False
    Cancel = True
    IndicateurFermeture = True
    Application.Dialogs(xlDialogSaveAs).Show
    Application.Quit
    End If
End Sub
 
Private Sub Workbook_Open()
 If ThisWorkbook.FullName = "C:\Documents and Settings\---------------\Mes documents\Classeur1.xlsm" Then IndicateurFermeture = False
 If ThisWorkbook.FullName <> "C:\Documents and Settings\---------------\Mes documents\Classeur1.xlsm" Then IndicateurFermeture = True
 
End Sub

et dans un module du colle:

Code:

Public IndicateurFermeture As Boolean

merci pour ton aide mais ca n'a pas fonctionner

j'ai changer de tactique et j'en ai prit une plus simple
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 Option Explicit Sub CheminFichier() If FichierExiste("nana") = True Then Application.Dialogs(xlDialogSaveAs).Show ("Dossier.xlsm") ElseIf DossierExiste("nana") = True Then Application.Dialogs(xlDialogSaveAs).Show ("Dossier.xlsm") Else End If End Sub Function FichierExiste(NomFichier As String) As Boolean FichierExiste = Dir(NomFichier, vbDirectory + vbHidden) <> "" End Function Function DossierExiste(NomDossier As String) As Boolean DossierExiste = Dir(NomDossier, vbDirectory + vbHidden) <> "" End Function
je voudrais juste qu'en plus de "Dossier" le macro récupère le nom du client puis la date qui seront dans 2 cellule distinctes de ma feuille 1, ce qui donnerai a l'enregistrement "Dossier - NomClient - Date"

21/05/2013, 12h53
jijie

en admettant que tu as le nom du client en feuil1 a1
en a2 tu as la date que tu transforme pour retiré les "/" donc en a3 tu mets cette formule: "=SUBSTITUE(A2;"/";"-")

Code:

Application.Dialogs(xlDialogSaveAs).Show ("Dossier_" & sheets("feuil1").range("a1") & "_" & sheets("feuil1").range("a3") & ".xlsm"

Merci pour ton code, mais vu que la date est obtenu avec la fonction aujourd'hui sur excel le reformatage que tu proposes me donner des chiffres bizarres 8O

du coup j'en ai pas prit compte et je m'en suis sorti ainsi

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Option Explicit
Sub CheminFichier()
Dim fichier As String
fichier = "\" & "Dossier " & Range("G5") & ".xlsm"
If FichierExiste("nana") = True Then
     Application.Dialogs(xlDialogSaveAs).Show fichier
ElseIf DossierExiste("nana") = True Then
    Application.Dialogs(xlDialogSaveAs).Show fichier
 
Else
    End If
End Sub
 
 
Function FichierExiste(NomFichier As String) As Boolean
    FichierExiste = Dir(NomFichier, vbDirectory + vbHidden) <> ""
End Function
Function DossierExiste(NomDossier As String) As Boolean
 
DossierExiste = Dir(NomDossier, vbDirectory + vbHidden) <> ""
 
End Function