Déterminer si le userform a été réduit, et si oui l'agrandir
beren57
-
Patrice33740 Messages postés 8930 Statut Membre -
Patrice33740 Messages postés 8930 Statut Membre -
Bonjour a tous
Je code pour mon travail un formulaire sous excel (2010) qui doit permettre une navigation plus facile dans la feuille de calcul, tout en laissant celle-ci accessible. J'ai donc utilisé dans mon userform le code ci dessous, trouve sur ce lien : https://codes-sources.commentcamarche.net/forum/affich-6018-fenetre-non-modale-en-vba-excel
Ce code fonctionne très bien, et jusqu'ici, je n'avais pas de problème avec.
Seulement voila : Jusqu'ici également, quand l'utilisateur essayait de quitter excel, il recevait un MsgBox d'avertissement lui demandant d'utiliser le bouton fait pour quitter, sur mon formulaire, et l’empêchait de fermer le document par ce biais.
Depuis peu, ces MsgBox dans mon code, je les ai remplacées par un userform pour avoir une MsgBox personnalisée. Je voulais pouvoir la positionner ou je voulais sur l'écran pour éviter qu'on la perde sous une fenêtre de travail et qu'elle bloque tout le reste.
Résultat : si on réduit le userform ET qu'on tente de quitter, le userform de la MsgBox personnalisée ne s'affiche plus (ou peut etre en reduit lui aussi, mais je ne vois rien), et tout se bloque en attendant qu'on clique sur "ok" (sauf que plus de bouton "ok" visible).
D'ou ma question : J'aimerais rajouter un bout de code a ma msgbox perso pour que, si le formulaire est reduit, il reprenne d'abord sa taille normale avant que la MsgBox ne s'affiche.
Si vous avez une solution pour me permettre de tester la chose, je vous serais très reconnaissant.
Merci d'avance
Beren57 (et désolé de pas pouvoir me créer de compte, mais comme j'ai dit, suis au boulot)
Je code pour mon travail un formulaire sous excel (2010) qui doit permettre une navigation plus facile dans la feuille de calcul, tout en laissant celle-ci accessible. J'ai donc utilisé dans mon userform le code ci dessous, trouve sur ce lien : https://codes-sources.commentcamarche.net/forum/affich-6018-fenetre-non-modale-en-vba-excel
Private Declare Function FindWindowA& Lib "user32" _
(ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function EnableWindow& Lib "user32" _
(ByVal hwnd&, ByVal bEnable&)
Private Declare Function GetWindowLongA Lib "User32" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "User32" _
(ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Sub UserForm_Activate ()
EnableWindow FindWindowA("XLMAIN", Me.caption),1
End Sub
Private Sub UserForm_Initialize()
Dim hWnd As Long
hWnd = FindWindowA(vbNullString, Me.Caption)
SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) Or &H20000
End Sub
Ce code fonctionne très bien, et jusqu'ici, je n'avais pas de problème avec.
Seulement voila : Jusqu'ici également, quand l'utilisateur essayait de quitter excel, il recevait un MsgBox d'avertissement lui demandant d'utiliser le bouton fait pour quitter, sur mon formulaire, et l’empêchait de fermer le document par ce biais.
Depuis peu, ces MsgBox dans mon code, je les ai remplacées par un userform pour avoir une MsgBox personnalisée. Je voulais pouvoir la positionner ou je voulais sur l'écran pour éviter qu'on la perde sous une fenêtre de travail et qu'elle bloque tout le reste.
Résultat : si on réduit le userform ET qu'on tente de quitter, le userform de la MsgBox personnalisée ne s'affiche plus (ou peut etre en reduit lui aussi, mais je ne vois rien), et tout se bloque en attendant qu'on clique sur "ok" (sauf que plus de bouton "ok" visible).
D'ou ma question : J'aimerais rajouter un bout de code a ma msgbox perso pour que, si le formulaire est reduit, il reprenne d'abord sa taille normale avant que la MsgBox ne s'affiche.
Si vous avez une solution pour me permettre de tester la chose, je vous serais très reconnaissant.
Merci d'avance
Beren57 (et désolé de pas pouvoir me créer de compte, mais comme j'ai dit, suis au boulot)
A voir également:
- Déterminer si le userform a été réduit, et si oui l'agrandir
- Comment savoir si on a été bloqué sur messenger - Guide
- Mon compte facebook a été désactivé - Guide
- Comment agrandir un tableau sur word - Guide
- Le compte facebook d'un ami a été piraté - Guide
- Le fichier à télécharger correspond au contenu brut d’un courrier électronique. de quel pays a été envoyé ce message ? - Guide
2 réponses
Bonjour,
1- pour avoir accès à une feuille alors que l'userform est affiché, inutile de faire tout ceci.
Me.Show 0 suffit.
2- pour éviter de réduire l'userform...
Cet UserForm sera présenté sans barre de fenêtre (cf Sub Masque_Barre) et pourra être déplacé manuellement en maintenant la touche Shift et le clic gauche de la souris enfoncés simultanément (cf Sub DeplaceForm et événement UserForm_MouseDown). Il pourra également permettre l'accès à la feuille...
Pour cela :
Puis place ce code dans le module de l'userform :
1- pour avoir accès à une feuille alors que l'userform est affiché, inutile de faire tout ceci.
Me.Show 0 suffit.
2- pour éviter de réduire l'userform...
Cet UserForm sera présenté sans barre de fenêtre (cf Sub Masque_Barre) et pourra être déplacé manuellement en maintenant la touche Shift et le clic gauche de la souris enfoncés simultanément (cf Sub DeplaceForm et événement UserForm_MouseDown). Il pourra également permettre l'accès à la feuille...
Pour cela :
- ouvre un nouveau classeur,
- insére un UserForm,
- sur cet userform dessine un bouton de commande.
Puis place ce code dans le module de l'userform :
Option Explicit
Private LeHwnD As Long
'=================== Evénements
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub UserForm_Activate()
Me.Show 0
End Sub
Private Sub UserForm_Initialize()
Masque_Barre Me.Caption
End Sub
Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'permet le déplacement de l'Userform par la combinaison Shift + clic gauche
If Button = 1 And Shift = 1 Then DeplaceForm
End Sub
'=================== Procédures
Public Sub Masque_Barre(strCapt As String)
Dim style As Long, index As Long
index = -16
LeHwnD = FindWindo("ThunderDFrame", strCapt)
style = GetWindoLong(LeHwnD, index) And Not &HC00000
SetWindoLong LeHwnD, index, style
DrawMenuB LeHwnD
End Sub
'=================== Utilisations des fonctions de l'api
Public Sub DeplaceForm()
'ReleaseCapture & SendMessageA
ExecuteExcel4Macro "CALL(""user32"",""ReleaseCapture"",""JJ"")"
ExecuteExcel4Macro "CALL(""user32"",""SendMessageA"",""JJJJJ"",""" & LeHwnD & """,""" & &HA1 & """,""" & &O2 & """,""0"")"
End Sub
Private Function FindWindo(ClassName As String, Caption As String) As Long
'FindWindowA
FindWindo = ExecuteExcel4Macro("CALL(""user32"",""FindWindowA"",""JCC""," & """" & ClassName & """" & ", " & """" & Caption & """)")
End Function
Private Function GetWindoLong(ByVal hwnd As Long, ByVal nIndex As Long) As Long
'GetWindowLongA
GetWindoLong = ExecuteExcel4Macro("CALL(""user32"",""GetWindowLongA"",""JCA""," & hwnd & ", " & nIndex & ")")
End Function
Private Sub SetWindoLong(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)
'SetWindowLongA
ExecuteExcel4Macro ("CALL(""user32"",""SetWindowLongA"",""JJJJJ""," & hwnd & ", " & nIndex & ", " & dwNewLong & ")")
End Sub
Private Sub DrawMenuB(H As Long)
'DrawMenuBar
ExecuteExcel4Macro ("CALL(""user32"",""DrawMenuBar"",""JJ"", " & H & ")")
End Sub
