Discussion :

[nonohzx]

Bonjour a tous,
Ce petit bout de code me permet de controler que l'utilisateur utilise la bonne version d'un programme.
Voici le code pour se mettre dans le bain :

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
51
52
Sub verif()
'*** Déclaration des variables
Dim Version As Double, Dossier As String, Fichier As String
Dim Mauvaise As String, PasTrouve As String, Trouve As Boolean, y As Integer
Dim Wbk As Workbook
'***
 
 
Version = 1 '<-- A changer a chaque modification meme mineur du programme
 
'With ThisWorkbook '<-- Récupération du chemin et du nom du programme
    'Dossier = .Path
    'Fichier = .Name
'End With
 
Dossier = "J:\P09-Gestion des systemes d'information\BAO" '<-- Dossier fixé a la racine de la BAO
Fichier = "XXX" '<-- Nom du programme initial
 
Application.StatusBar = "Vérification de la version en cours"
Mauvaise = "Votre version n'est plus d'actualité ! Veuillez recopier la dernière version du programme qui se trouve dans le répertoire suivant : " & Dossier
PasTrouve = "Programme non réferencé ! Veuillez en informer le service informatique."
Trouve = False
y = 3
 
'Masquer l'ouverture du classeur "Liste PG Info"
Application.ScreenUpdating = False
 
'Ouverture du classeur "Liste PG Info" et affectation de ce classeur à la variable Wbk
Set Wbk = Workbooks.Open("J:\P09-Gestion des systemes d'information\BAO\Liste PG Info.xls")
 
With Wbk.Sheets(1)
    Do While .Cells(y, 1) <> ""
        If .Cells(y, 1).Value = Fichier Then
            If .Cells(y, 2) = Version Then
                Trouve = True
                Exit Do
            ElseIf .Cells(y, 2) > Version Then
                MsgBox Mauvaise, vbCritical
                Application.Quit
            End If
        End If
        y = y + 1
    Loop
    If Trouve = False Then MsgBox PasTrouve, vbExclamation
    Wbk.Close False
End With
 
Set Wbk = Nothing '<-- libération de la mémoire
Application.StatusBar = False
Application.ScreenUpdating = True '<-- réactivation de l'écran
 
End Sub

Maintenant place au problème lorsque je lance le programme, en sachant que la version est inférieure a la version actuelle, le message enregistré dans la variable mauvaise devrait alors s'afficher en vb critical et excel devrait se fermer, sauf que le c'est pas du tout ce qui se passe... le message mauvaise apparait puis le message PasTrouvé puis l'input box de la suite du programme, d'ailleurs peu importe ce qu'on l'on renseigne on a une erreur et enfin en fesant soit fin ou débogage a la suite de cette erreur le programme se ferme...
Par contre quand on lance le programme en pas a pas, il fonctionne parfaitement bien comme si le programme allait trop vite et zappait le application.quit pour l’exécuter plus tard.

L'un de vous aurait-il une solution ? :/
Merci d'avance

[nonohzx]

J'ai peut-être trouvé une solution, barbare, en attendant de comprendre pourquoi ca ne fonctionne pas correctement.

Code :

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

vba.Interaction.Shell("TASKKILL /F /IM excel.exe")

J'essaierai demain.

[nonohzx]

Pour ceux que ça intéresse, j'ai apporté quelques modifs. Je test demain.

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
51
52
53
54
Sub verif()
'*** Déclaration des variables
Dim Version As Double, VersionLs As Double, Dossier As String, Fichier As String
Dim Mauvaise As String, PasTrouve As String, Trouve As Boolean, y As Integer
Dim Wbk As Workbook
'***
 
 
Version = 1 '<-- A changer a chaque modification meme mineur du programme
 
'With ThisWorkbook '<-- Récupération du chemin et du nom du programme
    'Dossier = .Path
    'Fichier = .Name
'End With
 
Dossier = "J:\P09-Gestion des systemes d'information\BAO" '<-- Dossier fixé a la racine de la BAO
Fichier = "XXX" '<-- Nom du programme initial
 
Application.StatusBar = "Vérification de la version en cours"
Mauvaise = "Votre version n'est plus d'actualité ! Veuillez recopier la dernière version du programme qui se trouve dans le répertoire suivant : " & Dossier
PasTrouve = "Programme non réferencé ! Veuillez en informer le service informatique."
Trouve = False
y = 3
 
'Masquer l'ouverture du classeur "Liste PG Info"
Application.ScreenUpdating = False
 
'Ouverture du classeur "Liste PG Info" et affectation de ce classeur à la variable Wbk
Set Wbk = Workbooks.Open("J:\P09-Gestion des systemes d'information\BAO\Liste PG Info.xls")
 
With Wbk.Sheets(1)                                      'Dans le Liste PG Info,
    Do While .Cells(y, 1) <> ""                         'on balaye la liste tant que la cellule n'est pas vide.
        If .Cells(y, 1).Value = Fichier Then            'Si la valeur de la cellule correspond au nom du programme alors,
            VersionLs = .Cells(y, 2)                    'on récupére le numéro de la version,
            Trouve = True                               'on indique que l'on a trouvé le programme dans la liste,
            Wbk.Close False                             'on ferme le Liste PG Info,
            Exit Do                                     'et on sort de la boucle, ca sert a rien de continuer.
        End If
    y = y + 1
    Loop
 
If Trouve = True And Version < VersionLs Then           'Si on a trouvé le programme dans la liste et que la version du programme est inférieure à la version actuelle alors,
    MsgBox Mauvaise, vbCritical                         'on affiche le message pour la mauvaise version,
    Application.Quit                                    'et on ferme le programme.
End If
If Trouve = False Then MsgBox PasTrouve, vbExclamation  'Si on n'a pas trouvé le programme dans la liste alors on affiche le message PasTrouve
 
End With
 
Set Wbk = Nothing '<-- libération de la mémoire
Application.StatusBar = False
Application.ScreenUpdating = True '<-- réactivation de l'écran
 
End Sub

[nonohzx]

Le taskkill fonctionne forcément, faut juste espérer que les gens ouvrent pas plusieurs excel et qu'ils ne font pas de modif sans enregistrer sinon je sens les plaintes arrivées ... Autrement j'ai essayé de modifier le programme pour faire fonctionner l'application.quit mais rien n'y fait ... en pas a pas ca fonctionne mais pas en auto.