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

Question

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

CerberusPau · Accepted Answer

1000 Mercis à Charles Racaud !!!!
http://www.vbfrance.com/forum/sujet-USERFORM-1ER-PLAN_992499.aspx
ça maaaarrrche, et c'est lumineux de simplicité !

Rataxes64

c148270 · Answer

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

CerberusPau · Answer

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

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

3 réponses

Votre réponse

Discussions similaires