application ouvert

Bonjour BL,

Je recherche le moyen d'empecher l'ouverture du programme si le la base
est deja ouverte.

Peut-être que tu peux ajouter le commutateur /excl dans la ligne de commande
de ton raccourci pour une ouverture en mode exclusif.

Tisane

Bonjour

Avec le code ci dessous dans un module standard,
Tu l'utilise avec
If fIsAppRunning(LeNomDeTonAppli) = True Then

endif

'******************** Code Start ************************
Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Const SW_NORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_MAXIMIZE = 3
Private Const SW_SHOWNOACTIVATE = 4
Private Const SW_SHOW = 5
Private Const SW_MINIMIZE = 6
Private Const SW_SHOWMINNOACTIVE = 7
Private Const SW_SHOWNA = 8
Private Const SW_RESTORE = 9
Private Const SW_SHOWDEFAULT = 10
Private Const SW_MAX = 10

Private Declare Function apiFindWindow Lib "user32" _
Alias "FindWindowA" (ByVal strClass As String, _
ByVal lpWindow As String) As Long

Private Declare Function apiSendMessage Lib "user32" _
Alias "SendMessageA" (ByVal Hwnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
lParam As Long) As Long

Private Declare Function apiSetForegroundWindow Lib "user32" _
Alias "SetForegroundWindow" (ByVal Hwnd As Long) As Long

Private Declare Function apiShowWindow Lib "user32" _
Alias "ShowWindow" (ByVal Hwnd As Long, _
ByVal nCmdShow As Long) As Long

Private Declare Function apiIsIconic Lib "user32" _
Alias "IsIconic" (ByVal Hwnd As Long) As Long
'

Function fIsAppRunning(ByVal strAppName As String, _
Optional fActivate As Boolean) As Boolean
Dim lngH As Long, strClassName As String
Dim lngX As Long, lngTmp As Long
Const WM_USER = 1024
On Local Error GoTo fIsAppRunning_Err
fIsAppRunning = False
Select Case LCase$(strAppName)
Case "excel": strClassName = "XLMain"
Case "word": strClassName = "OpusApp"
Case "access": strClassName = "OMain"
Case "powerpoint95": strClassName = "PP7FrameClass"
Case "powerpoint97": strClassName = "PP97FrameClass"
Case "notepad": strClassName = "NOTEPAD"
Case "paintbrush": strClassName = "pbParent"
Case "wordpad": strClassName = "WordPadClass"
Case Else: strClassName = ""
End Select

If strClassName = "" Then
lngH = apiFindWindow(vbNullString, strAppName)
Else
lngH = apiFindWindow(strClassName, vbNullString)
End If
If lngH <> 0 Then
apiSendMessage lngH, WM_USER + 18, 0, 0
lngX = apiIsIconic(lngH)
If lngX <> 0 Then
lngTmp = apiShowWindow(lngH, SW_SHOWNORMAL)
End If
If fActivate Then
lngTmp = apiSetForegroundWindow(lngH)
End If
fIsAppRunning = True
End If
fIsAppRunning_Exit:
Exit Function
fIsAppRunning_Err:
fIsAppRunning = False
Resume fIsAppRunning_Exit
End Function
'******************** Code End ************************

Gilbert



"BL" <bl@sidiac.fr> a écrit dans le message de
news:43f33a0f$0$21273$8fcfb975@news.wanadoo.fr...

bonjour,

Je recherche le moyen d'empecher l'ouverture du programme si le la base
est

deja ouverte.

Merci de votre aide.

Merci pour vos réponse

"BL" <bl@sidiac.fr> a écrit dans le message de news:
43f33a0f$0$21273$8fcfb975@news.wanadoo.fr...

bonjour,

Je recherche le moyen d'empecher l'ouverture du programme si le la base
est deja ouverte.

Merci de votre aide.