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 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
|
Private Declare Function FindWindow _
Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function PostMessage _
Lib "user32" Alias _
"PostMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Declare Function GetWindowText _
Lib "user32" _
Alias "GetWindowTextA" ( _
ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long
Public Declare Function EnumWindows _
Lib "user32" ( _
ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long
Dim Ouvert As Boolean
Dim NomProg As String
Dim TitreFenetre As String
Sub Fermer()
Dim lResult As Long
'
NomProg = "Excel" 'cherche si Excel est ouvert
'parcour les application lancées
lResult = EnumWindows(AddressOf ProgrammeOuvert, 0&)
If Ouvert = True Then
If MsgBox("Le programme '" & NomProg & "' est ouvert sous le titre de fenêtre '" & _
TitreFenetre & "'." & vbCrLf & "Voulez-vous fermer ce programme ?", vbYesNo + vbQuestion) = vbYes Then
PostMessage FindWindow(vbNullString, TitreFenetre), &H10, 0, 0
End If
Else
MsgBox "Le programme " & NomProg & " n'est pas ouvert !"
End If
End Sub
'cherche dans le titre des fenêtres le nom du programme
Public Function ProgrammeOuvert(ByVal hWnd As Long, _
ByVal lgParam As Long) As Long
Dim Tampon As String
Dim Result As Long
Tampon = Space(255)
Result = GetWindowText(hWnd, Tampon, 255)
If Left(Tampon, 1) <> Chr(0) Then
'non sensible à la casse (UCase)
If InStr(UCase(Trim(Tampon)), UCase(NomProg)) <> 0 Then
Ouvert = True
TitreFenetre = Trim(Tampon) 'retourne le titre de la fenêtre
Exit Function
Else
Ouvert = False
End If
End If
ProgrammeOuvert = 1
End Function |
Partager