[déplacé VB.NET -> VBA] UserForm d'Alerte en premier plan [Résolu]

CerberusPau 376 Messages postés lundi 3 avril 2006Date d'inscription 7 avril 2015 Dernière intervention - 1 oct. 2009 à 11:58 - Dernière réponse : CerberusPau 376 Messages postés lundi 3 avril 2006Date d'inscription 7 avril 2015 Dernière intervention
- 10 avril 2010 à 23:40
Bonjour,
J'ai une macro en VBA qui lance au bout de 2 minutes d'inactivité sous Excel un UserForm qui rappelle que le fichier va se fermer dans 10 secondes sans action de relance (cet UF affiche un bouton de relance et le décompte des 10 secondes restantes).

Le problème est de remettre au premier plan le classeur Excel concerné pour que le UF soit visible.
Soit que le classeur soit en arrière plan, soit qu'il soit réduit (icône dans la barre des tâches)

J'ai tenté beaucoup de choses proposées sur le forum, par Shell, FindWindow + SetForegroundWindow, SetWindowPos, ... Mais sans succès...
Voici un de mes essais de code infructueux
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Any) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Sub SeeWindow()
m_hWnd = FindWindow(vbNullString, "Micosoft Excel - TOTO.xls")
Call SetForegroundWindow(m_hWnd)
End Sub

Rien à faire: au mieux, l'icône de la barre des tâches clignotte, mais la fenêtre en premier plan reste active: elle "masque" le UF et "bloque" la macro (UF est pourtant en ShowModal=False !)
Amical Merci pour toute aide

Rataxes64
Afficher la suite 

3 réponses

Répondre au sujet
CerberusPau 376 Messages postés lundi 3 avril 2006Date d'inscription 7 avril 2015 Dernière intervention - 10 avril 2010 à 23:40
+3
Utile
1000 Mercis à Charles Racaud !!!!
http://www.vbfrance.com/forum/sujet-USERFORM-1ER-PLAN_992499.aspx
ça maaaarrrche, et c'est lumineux de simplicité !

Rataxes64
Cette réponse vous a-t-elle aidé ?  
Commenter la réponse de CerberusPau
c148270 303 Messages postés mercredi 12 janvier 2005Date d'inscription 3 octobre 2013 Dernière intervention - 2 oct. 2009 à 11:11
0
Utile
Bonjour
Je n'ai pas tout compris mais voici un module que me permet d'activer une base access réduite en barre de tâche avec affiche d'un formulaire, un état ou une requête en édition.

Option Compare Database

Const GW_HWNDFIRST = 0
Const GW_HWNDLAST = 1
Const GW_HWNDNEXT = 2
Const GW_HWNDPREV = 3
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
'DECLARATION DES APIS UTILISEES
Declare Function SetForegroundWindow Lib "user32" _
(ByVal hwnd As Long) As Long

'récupère le handle d'une fenêtre
Declare Function GetWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
'récupère le titre d'une fenêtre
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
'récupère la longueur du titre d'une fenêtre
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long

'récupère le handle de la fenêtre mère d'une fenêtre
Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
'rend une fenêtre active d'après son handle
Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As Long) As Long
'détermine si une fenêtre est visible ou pas
Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
'récupère le handle de la fenêtre active
Declare Function GetActiveWindow Lib "user32" () As Long

Function LoadTaskList(nomformulaire)

'Function LoadTaskList(AppActive1() As String) As Integer
'Fonction qui recherche la liste des applications actives en
'récupérant le titre de la fenêtre

Dim hWd As Long, CurrWnd As Double
Dim essai As Integer
i = 0
hWd = GetActiveWindow()
CurrWnd = GetWindow(hWd, GW_HWNDFIRST)
While (CurrWnd <> 0)
length = GetWindowTextLength(CurrWnd)
listitem$ = Space$(length)
length = GetWindowText(CurrWnd, listitem$, length + 1)
'teste si la longueur du titre est supérieure a 1,
'si la fenêtre n'a pas de fenêtre mère,
'et si elle est visible
If listitem$ = "Microsoft Access - [" & nomformulaire & " : État]" Then
retval = SetForegroundWindow(CurrWnd)
retval = ShowWindow(CurrWnd, 1)
retval = ShowWindow(CurrWnd, 1)
Exit Function
End If
If listitem$ = "Microsoft Access - [" & nomformulaire & " : Formulaire]" Then
retval = SetForegroundWindow(CurrWnd)
retval = ShowWindow(CurrWnd, 1)
retval = ShowWindow(CurrWnd, 1)
Exit Function
End If
If Mid(listitem$, 1, Len("Microsoft Access - [" & nomformulaire & " : Requête")) = "Microsoft Access - [" & nomformulaire & " : Requête" Then
retval = SetForegroundWindow(CurrWnd)
retval = ShowWindow(CurrWnd, 1)
retval = ShowWindow(CurrWnd, 1)
Exit Function
End If
i = i + 1
CurrWnd = GetWindow(CurrWnd, GW_HWNDNEXT)
x = DoEvents()
Wend
LoadTaskList = i

End Function

A adpter à votre besoin

Bonne journée
Commenter la réponse de c148270
CerberusPau 376 Messages postés lundi 3 avril 2006Date d'inscription 7 avril 2015 Dernière intervention - 10 avril 2010 à 22:56
0
Utile
Bonjour,
Cela fait des mois que je travaille la réponse
de c148270 (que je remercie) mais sans succès.
Pour être plus clair je vais reformuler mon problème:
1) Mon fichier Excel est en réseau et ne peut pas être en mode partagé, donc si un utilisateur oublie de le fermer, il bloque tout le monde...
2) Une macro est lancée en cas d'inactivité dans le fichier pour le fermer au bout de 2mn.
3) Avant la fermeture effective, une autre macro affiche une Form qui donne le décompte des 10 dernières secondes (avec un bip sonore à chaque seconde).
4) Ce que je voudrais, c'est que cette Form passe au premier plan des autres fenêtres ouvertes, car si ce n'est pas le cas, curieusement la macro ne déroule plus, et donc le fichier ne se ferme pas (pourtant la Form est bien en mode non modal)
Voila mon code actuel (je suis désolé de sa longeur...)
1) Je cherche la fenêtre dont l'intiltulé contient le mot Prog en utilisant les cellules d'une feuille Exel
2) Je demande l'affichage de cette fenêtre en premier plan
Const GW_HWNDFIRST = 0 
Const GW_HWNDLAST = 1 
Const GW_HWNDNEXT = 2 
Const GW_HWNDPREV = 3 
'**************************************************
Public Declare Function FindWindow Lib "user32" _
    Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long   'fonction FindWindow
'**************************************************
Private Declare Function IsWindowVisible Lib "user32" ( _
    ByVal hWnd As Long) As Long             'affichage reconnu
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) 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           'envoyer messages
'**************************************************
Declare Function EnumWindows Lib "user32" ( _
    ByVal lpEnumFunc As Long, _
    ByVal lParam As Long) As Boolean        'décomptage
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
    ByVal hWnd As Long, _
    ByVal lpString As String, _
    ByVal cch As Long) As Long              'récupérer le texte
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" ( _
    ByVal hWnd As Long) As Long             'récupérer la taille du texte
'**************************************************
Dim Temp As String                          'tampon
'**************************************************

Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Boolean
'=> Proc

Dim sSave As String, Ret As Long
ouverte = ""                                'élaboration des textes de fenêtres
Ret = GetWindowTextLength(hWnd)             'séparés du caractère  £ pour pouvoir
sSave = Space(Ret)                          'les extraire et les analyser ensuite
GetWindowText hWnd, sSave, Ret + 1
If sSave <> vbNullString And IsWindowVisible(hWnd) Then Temp = Temp & sSave & "£"
EnumWindowsProc = True
End Function

'**************************************************

Public Function App_Ouverte()
'=> Application ouverte

Worksheets(1).Unprotect (VBpassword)        'déprotection de la feuille en VB (si besoin)
EnumWindows AddressOf EnumWindowsProc, ByVal 0&     'attribution de la Proc
Worksheets(1).Range("AA1").Value = ""       'vidage de la Cellule de récupération générale AA1
Worksheets(1).Range("AA1").Value = Temp     'Valeur des tous les textes trouvés sur une seule ligne en AA1
App_Ouverte = Temp                          'reprise du tampon
Temp = ""                                   'reset les infos dans le tampon
End Function
'**************************************************

Sub ShowWindowProg()
'=> SUB PRINCIPALE A LANCER

Worksheets(1).Unprotect (VBpassword)        'protection désactivée
Worksheets(1).Select
Set s = ActiveSheet                         'PAS de .Select...
'Afficher des colonnes masquées
s.Columns("L:IV").Hidden = False            'affiche les colonnes L à IV
Range("IV1").End(xlToLeft).Select           '.Select (!) la cellule en dernière colonne non vide en ligne 1
'Vider les celllules de destination au préalable
EndCol = ActiveCell.Column + 1              'récupérer le N° de la dernière colonne depuis la première affichée (A)
Vcol = 27
For Vcol 27 To EndCol                     'Pour w N° de la dernère colonne en ligne 1...
    s.Cells(1, Vcol).Activate               'cellule active
    NmVCol = Left(ActiveCell.Address(0, 0), (ActiveCell.Column < 27) + 2) 'donne le NOM de la colonne
    If Range("" & NmVCol & "1").Value = "" Then Exit For 'si la cellule est vide, on sort du For
    ZzDir = Range("" & NmVCol & "1").Value   'c'est le nom de la fenêtre analysée à chaque boucle
    If ZzDir <> "" Then Range("" & NmVCol & "1").Value = "" 'vidage de la cellule
Next Vcol
App_Ouverte                                 'appelle la fonction
s.Range("AA1").TextToColumns Destination:=Range("AA1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="£", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), _
        TrailingMinusNumbers:=True          'Conversion par le signe £ (chaque texte est dans une cellule de la ligne 1 à partir de AA1
'Attention : AUCUNE colonne cachée...
Range("IV1").End(xlToLeft).Select           '.Select (!) la cellule en dernière colonne non vide en ligbe 1
NbCol = ActiveCell.Column + 1               'récupérer le N° de la dernière colonne depuis la première affichée (A)
'Dim w
ZzDir = ""
W = 27                                      'on démarre la boucle depuis AA1 (colonne 27)
For W = 27 To NbCol                         'Pour w= N° de la dernère colonne en ligne 1...
    s.Cells(1, W).Activate                  'cellule active
    NmCol = Left(ActiveCell.Address(0, 0), (ActiveCell.Column < 27) + 2) 'donne le NOM de la colonne
    If Range("" & NmCol & "1").Value = "" Then Exit For 'si la cellule est vide, on sort du For
    ZzDir = Range("" & NmCol & "1").Value   'c'est le nom de la fenêtre analysé à chaque boucle
    Set W1 = Range("" & NmCol & "1").Find("Prog")       'en W1 : le mot Prog
    If Not W1 Is Nothing Then
        ShowWindow (ZzDir)                 'la fenêtre contenant le mot en Prog W1 est activée
    End If                                  
    Range("" & NmCol & "1").Value = ""      'Vidage de la cellule analysée
Next W                                      'reprise de la boucle
s.Columns("L:IV").Hidden = True             'masque les colonnes L à IV
Range("A1").Select
Worksheets(1).Protect PassWord:=VBpassword, DrawingObjects:=False, Contents:=True, Scenarios:=True, AllowFiltering:=True ' reverrouillage VB
End Sub
'**************************************************

Sub ShowWindow(ZzDir)
'=> Commande d'affichage de la fenêtre contenant Prog
Dim hWnd As Long
hWnd = FindWindow(vbNullString, ZzDir)
If hWnd > 0 Then
    Call PostMessage(hWnd, GW_HWNDFIRST, 0, 0)
End If
End Sub
'**************************************************

...Marche pas !
Ce doit être mes Const et mes appels d'API qui ne sont pas bons : je sèche dur...
Et puis, on doit pouvoir éviter de passer par une feuille Excel, non ?...
Merci d'une aide salvatrice
Rataxes64
Commenter la réponse de CerberusPau

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.