Discussion :

[philou75]

Bonjour,

Je me permets de m'adresser à vous car après maintes recherches sur le NET et questions à GOOGLE, je n'ai rien trouvé de pertinent.

Voici le contexte :
Je me suis fait un classeur avec 1 feuille pour gérer des opérations que je devais répéter plusieurs fois par jour.
Dans les cellules de la feuille, il y a des formules et j'ai fait un peu de VBA dans un module pour me faire des fonctions simples que j'utilise dans mes formules.
Cela fonctionne très bien et je suis satisfait de ce que j'ai réussi à faire.
MAIS IL NE FAUT JAMAIS ENREGISTRER LES MODIFICATIONS AYANT ETE EFFECTUEES.
Donc, tant que j'étais le seul à m'en servir ... il n'y avait pas de pb car je ne faisais jamais l'une des actions suivantes :
1) MENU / FICHIER / ENREGISTRER
ou
2) MENU / FICHIER / ENREGISTRER SOUS
et
3) je répondais TOUJOURS "ne pas enregistrer" quand en quittant la boite de dialogue EXCEL me signalait que je n'avais pas enregistré mes modifications.

Mais maintenant je ne suis plus le seul à l'utiliser.
Et si MOI je faisais très attention, ce n'est malheureusement pas le cas de mes collègues.

J'ai donc cherché à gérer ou plutot intercepter ces 3 actions en VBA.
J'ai commencé à écrire quelquechose en utilisant l'event Workbook_Beforesave
J'ai réussi à traiter le cas 1
Mais je n'arrive pas à traiter le cas 2 dans sa globalité.

En effet j'arrive à intercepter l'enregistrer sous en détectant SAVEASUI = true
mais j'ai beau forcer
cancel = true
et
saveasui = false
JE NE RETOURNE JAMAIS SUR LA FEUILLE de mon classeur !
L'interface EXCEL reste bloquée sur l'écran ENREGISTRER SOUS ... avec la liste des "RECENTS" ou du bouton parcourir.

d'où ma question :
que faut il faire dans la proc beforesave pour qu'excel revienne à la feuille de mon classeur
plutot que de rester bloqué sur l'écran ENREGISTRER SOUS.
(alors que ça marche très bien pour enregistrer : je l'intercepte, je l'annule et EXCEL me rend la mais sur ma feuille)

Pour info, voici le code de ma Proc Beforesave :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 
    MsgBox "Vous ne pouvez pas sauvegarder ce classeur"
    If SaveAsUI = True Then
        SaveAsUI = False
    End If
    Cancel = True
 
End Sub

Merci d'avance de votre aide.
Cdt.
Philou75

[patricktoulon]

bonsoir
ben tout simplement parceque la fentre est bloquante et donc soit tu sauve soit tu annule dans la fentre "enregistrer sous "

moi je serait plus dur histoire de faire comprendre au recalcitrants qu'il ne faut pas le faire
met toi en mode creation (ca désactive le macros)

dans ton module thiworkbook met ceci et sauve le

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True
With Application: .DisplayAlerts = False: .Quit: End With
End Sub

ferme ton fichier
réouvre le et essaie de faire enregistrer sous ou simplement enregistrer walouh walouh bye!!bye!! plus d'exel le fichier se ferme y compris l'application c'est brutal ca fait CH....!!!! mais au bout d'un moment ils ne le feront plus tes collegues

2d solution si vraiment cancel ne suffit pas pour "enregistrer sous" embaucher un fantome qui va taper la touche esc a la place de l'utisateur
de cette facon

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = True
    If SaveAsUI = True Then
        fichier = Environ("userprofile") & "\Desktop\escape.vbs"
        x = FreeFile
        Open fichier For Output As #x: Print #x, "WScript.CreateObject(""WScript.Shell"").sendkeys""{ESC}""": Close #x
        With CreateObject("wscript.shell").Run(fichier): End With
        MsgBox "un msgbox fantome que l'on a meme pas le temps de voir "
        Kill fichier
    End If
End Sub

[philou75]

Bonsoir le Forum, et un grand merci à Patrick.

Patrick,

J'ai appliqué le principe de ta 2eme solution
c'est exactement ce dont j'avais besoin
et ça marche impeccablement ... Génial :=)

Je dis "le principe" car j'ai dû faire 2 adaptations de ton code ...

1°) ... au niveau du chemin du répertoire pour la création du script escape.vbs
Je l'ai créé dans MON REPERTOIRE TEMP car je n'ai pas les autorisations d'écriture et de suppression partout sur mon c:.
A cet endroit là, j'en suis certain.

Pour cela je me suis inspiré du code que j'ai trouvé sur ce lien
https://www.rondebruin.nl/win/s3/win027.htm
qui proposait une SUB et j'en ai fait une fonction.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Public Function Get_Temp_Folder_2() As String
' 0 = The Windows folder contains files installed by the Windows operating sys
' 1 = The System folder contains libraries, fonts, and device drivers
' 2 = The Temp folder is used to store temporary files. Its path is found in the TMP environment variable.
 
    Dim FSO As Object, TmpFolder As Object
    Set FSO = CreateObject("scripting.filesystemobject")
    Set TmpFolder = FSO.GetSpecialFolder(2)
    Get_Temp_Folder_2 = TmpFolder
End Function

Ainsi, la ligne que tu as proposée ... fichier = Environ("userprofile") & "\Desktop\escape.vbs"
devient alors ... fichier = Get_Temp_Folder_2 & "\escape.vbs"

2°) ... pour pouvoir faire le KILL du script vbs, il fallait être sûr que le run était terminé.
Pour cela, j'ai ...
a) récupéré le module complet proposé sur ce lien :
http://www.cpearson.com/Excel/ShellAndWait.aspx
b) j'ai rajouté une variable STRING
fichier_wait = "wscript.exe " & fichier
et une variable VARIANT y
c) et j'ai remplacé la ligne initiale ... With CreateObject("wscript.shell").Run(fichier): End Withpar ... y = ShellAndWait(fichier_wait, 0, vbHide, 0)

CONCLUSIONS :
Pour ceux qui seraient intéressés, voici le code complet final ET QUI FONCTIONNE !!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
45
46
47
48
49
50
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'
    Dim fichier As Variant
    Dim fichier_wait As String
    Dim x As Variant
    Dim y As Variant
    Dim NF As String
 
    Debug.Print "Private Sub Workbook_Beforesave"
 
    Cancel = True
 
    If SaveAsUI = True Then
 
        MsgBox "Désolé, Enregistrer sous ... INTERDIT DANS CE CLASSEUR", 0, vbNullString
        fichier = Get_Temp_Folder_2 & "\escape.vbs"
        x = FreeFile
 
        Open fichier For Output As #x
        Print #x, "WScript.CreateObject(""WScript.Shell"").sendkeys""{ESC}"""
        Close #x
 
        fichier_wait = "wscript.exe " & fichier
        y = ShellAndWait(fichier_wait, 0, vbHide, 0)
'
'     Success = 0
'     Failure = 1
'     TimeOut = 2
'     InvalidParameter = 3
'     SysWaitAbandoned = 4
'     UserWaitAbandoned = 5
'     UserBreak = 6
 
        Debug.Print "Code Retour du ShellAndWait = " & y
 
        NF = Dir(fichier)
        Debug.Print "Avant KILL / NF = " & NF
 
        Kill fichier
 
        NF = Dir(fichier)
        Debug.Print "Après KILL / NF = " & NF
 
    Else
 
        MsgBox "Désolé,  Enregistrer les modifs effectuées ... INTERDIT DANS CE CLASSEUR", 0, vbNullString
 
    End If
 
End Sub

FONCTIONNEMENT :
Quand on choisit MENU / FICHIER / ENREGISTRER SOUS / Choix d'une destination ...
la MSGBOX apparait ... signalant : Désolé, Enregistrer sous ... INTERDIT DANS CE CLASSEUR ... avec 2 possibilités : BOUTON OK ou la Croix en haut à droit = Fermer
L'une ou l'autre ... Le résultat est le même ... on quitte le MENU Enregistrer Sous et on revient au classeur ...
CQFD

Et voici ce qui s'est affiché dans la fenêtre d'Execution

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Private Sub Workbook_Beforesave
Code Retour du ShellAndWait = 0
Avant KILL / NF = escape.vbs
Après KILL / NF =

Merci encore à Patrick.
Bonne continuation à tous.
A la prochaine.
Cdt. Philou75

[patricktoulon]

re
sans deconner tu es aller chercher shellandwait!!!!!????
ben ecoute je suis ravi pour toi mais honnetement il y avait plus court
regarde du coté du comment lister les processus avec WMI
quand WMI ne trouve plus wscript.exe tu kill

serieux
j'ai regarder le lien c'est pas la meilleur version que j'ai vu en plus mais de toute facon la pour un wait de quelques milimimli faut pas deconner pas la peine de sortir le chart d'assaut

WMI !!!

[patricktoulon]

tiens ce soir je prend 5 minute pour toi
test ca

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
ThisWorkbook.Close (savechange = True)
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim objWMIService, proccessus, strComputer, strList, ok As Boolean, x&
    Cancel = True
    If SaveAsUI = True Then
        fichier = Environ("userprofile") & "\Desktop\escape.vbs"'chemin a adapter a ta convenance
        x = FreeFile
        Open fichier For Output As #x: Print #x, ":with WScript.CreateObject(""WScript.Shell""):.sendkeys""{ESC}"":end with: ": Close #x
        With CreateObject("wscript.shell")
            .Run (fichier)
        End With
 
        'waiting an kill
're:
'Err.Clear
        ok = True
        'On Error GoTo re
        Do Until ok = False
            DoEvents
            ok = False
            strComputer = "."
            Set proccessus = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2").ExecQuery("Select * from Win32_Process")
            For Each objProcess In proccessus
                DoEvents
                'x = x + 1: Cells(x + 1, 1).Value = objProcess.Name
                If objProcess.Name = "wscript.exe" Then ok = True: Exit For
            Next
        Loop
        Kill fichier
        MsgBox "nan nan !!!!!! pas question d'enregistrer tete d'enclume!!!!"
    End If
End Sub

[philou75]

Bonjour Patrick,

Désolé j'étais en déplacement...

Merci pour cette nouvelle solution.
J'ai bien vu ? ... tu me proposes une solution fondée sur WMI ... comme tu l'avais dit !

Je ne connais pas WMI ... je vais chercher ce que c'est ...
Jamais entendu parlé avec EXCEL !
Et donc tu préfères ? je veux dire tu préfères passer par la solution WMI que le ShellandWait ?

Quels sont les avantages du WMI ?
En tout cas merci encore et bien sur je vais tester et reviendrai pour des commentaires.

Bonne journée.
A+
Philou75