Microsoft 365 MsgBox

[Tioneb_h]

Bonjour,

Y-a-t’il moyen de centrer la fenêtre du "MsgBox" sur la page Excel qui est ouverte et non pas sur le centre de l'écran ? 🤔

voici mon code au cas où :

Private Sub CommandButton5_Click()
 
Dim reponse As Integer

reponse = MsgBox("     Verrouiller les Prix Unitaires ?", vbQuestion + vbYesNoCancel, "     Copier / Coller vers un autre fichier")

If reponse = vbCancel Then
Cancel = True

ElseIf reponse = vbYes Then Call VerrouillerCopierColler

ElseIf reponse = vbNo Then Call CopierColler

End If
End Sub

Merci d'avance, 😉
Benoît

 

[bouchard]

Bonjour Benoit,
non, la fonction Msgbox ne permet pas de la positionner à l'écran.
Une solution, pas très simple, serait de se créer un formulaire qui reprend l'apparence du Msgbox et qui pourait être positionné là où l'on souhaite.
Cdlt

 

[Phil69970]

Bonjour @Tioneb_h
Edit Bonjour @bouchard

Je te propose le fichier de cette discussion fait par quelques pointures d'excel

Place d'une MsgBox

Bonsoir le Forum, Tiens il m'arrive une chose que j'voudrais bien résoudre...en tant normal une MsgBox apparaît naturellement au centre de l'écran...jusque là pas de problème... ma question : comment faire pour que cette même MsgBox apparaisse à un endroit précis sur la feuille...je pense...

excel-downloads.com

Attention il faudra rajouter Ptrsafe si tu as une version excel 64 bits comme moi

Merci de ton retour

@Phil69970

 

[patricktoulon]

bonjour
allez pour le fun
tu reprends mon exemple de msgbox temporisé avec settimer qui agit en addressof et tu remplace le tempo par un repositionnement
comme ça vite fait je dirais
au lieu d'appeler le msgbox ( msgbox(blablabla))
tu l'appelle de la même manière mais par msgboxpos(blablabla)
tester la sub "test2"

'***************************************************************************************************************************
'**********************************************************************************
' __        _____  ___   .  ___         _____  ___             ___
'|__|  /\     |   |   |  | |     | /      |   |   | |   | |   |   | |\  |
'|    /__\    |   |---   | |     |/\      |   |   | |   | |   |   | | \ |
'|   /    \   |   |   \  | |___  |  \     |   |___| |___| |__ |___| |  \|
'
'***********************************************************************************
'                                                   COLLECTION BOITE DE DIALOGUE PERSO                                                  *                              COLLECTION BOX OF PERSONAL DIALOGUE                                                                *
'                                                     le vrai msgbox repositionnable                                                           *                                       The calendar Control                                                                      *
'Auteur: patricktoulon sur exceldownload                                                                                                *Author: patricktoulon on exceldownload                                                                                           *
'date version:18/04/2023
'version 1.0
'***************************************************************************************************************************

Option Explicit
#If VBA7 Then
    Private Declare PtrSafe Function SetTimer Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
    Private Declare PtrSafe Function KillTimer Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long) As Long
    Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Dim x As LongPtr
#Else
    Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Dim x As Long
#End If
Dim MsgBoxTitle$
Dim timerID&
Function msgboxPos(message As String, Optional style As VbMsgBoxStyle = vbOKOnly, Optional titre As String = "message")
    Dim Response$
    MsgBoxTitle = titre
    timerID = SetTimer(0, 0, 100, AddressOf repositionneMsgbox)
    Response = MsgBox(message, style, titre)
    msgboxPos = Response
End Function
Sub repositionneMsgbox()
    Dim posLeft&, PosTop&
    With Application
        posLeft = Int((.Left + ((.Width - 220) / 2)) * (4 / 3)) + 20
        PosTop = Int((.Top + ((.Height - 150) / 2)) * (4 / 3))
    End With
    x = FindWindow(vbNullString, MsgBoxTitle)
    SetWindowPos x, -1, posLeft, PosTop, 220, 150, &H0
    On Error Resume Next
    If timerID <> 0 Then KillTimer 0, timerID: timerID = 0:
End Sub


'exemple de simple msgbox d'avertissement
Sub test2()
    msgboxPos "coucou tout lemonde", vbOK + vbInformation, "messageTest"
End Sub

c'é bo la vie non?
a perfectionner:
par exemple avec api getwindowrect le rectangle du message pour avoir les vrai dimmentions d'orrigine
ici je l'impose a 220 de large et 150 de haut

faut pas m'en vouloir j'ai fait ça en 10 minutes
😉

 

[Tioneb_h]

Bonjour @Tioneb_h
Edit Bonjour @bouchard

Je te propose le fichier de cette discussion fait par quelques pointures d'excel

Place d'une MsgBox

Bonsoir le Forum, Tiens il m'arrive une chose que j'voudrais bien résoudre...en tant normal une MsgBox apparaît naturellement au centre de l'écran...jusque là pas de problème... ma question : comment faire pour que cette même MsgBox apparaisse à un endroit précis sur la feuille...je pense...

excel-downloads.com

Attention il faudra rajouter Ptrsafe si tu as une version excel 64 bits comme moi

Merci de ton retour

@Phil69970

Bonjour,

Je suis débutant dans Excel... je n'ai jamais utilisé UserForm 😇. Je vais approfondir la chose.
Merci à vous,

Benoît

 

[Tioneb_h]

bonjour
allez pour le fun
tu reprends mon exemple de msgbox temporisé avec settimer qui agit en addressof et tu remplace le tempo par un repositionnement
comme ça vite fait je dirais
au lieu d'appeler le msgbox ( msgbox(blablabla))
tu l'appelle de la même manière mais par msgboxpos(blablabla)
tester la sub "test2"

'***************************************************************************************************************************
'**********************************************************************************
' __        _____  ___   .  ___         _____  ___             ___
'|__|  /\     |   |   |  | |     | /      |   |   | |   | |   |   | |\  |
'|    /__\    |   |---   | |     |/\      |   |   | |   | |   |   | | \ |
'|   /    \   |   |   \  | |___  |  \     |   |___| |___| |__ |___| |  \|
'
'***********************************************************************************
'                                                   COLLECTION BOITE DE DIALOGUE PERSO                                                  *                              COLLECTION BOX OF PERSONAL DIALOGUE                                                                *
'                                                     le vrai msgbox repositionnable                                                           *                                       The calendar Control                                                                      *
'Auteur: patricktoulon sur exceldownload                                                                                                *Author: patricktoulon on exceldownload                                                                                           *
'date version:18/04/2023
'version 1.0
'***************************************************************************************************************************

Option Explicit
#If VBA7 Then
    Private Declare PtrSafe Function SetTimer Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
    Private Declare PtrSafe Function KillTimer Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long) As Long
    Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Dim x As LongPtr
#Else
    Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Dim x As Long
#End If
Dim MsgBoxTitle$
Dim timerID&
Function msgboxPos(message As String, Optional style As VbMsgBoxStyle = vbOKOnly, Optional titre As String = "message")
    Dim Response$
    MsgBoxTitle = titre
    timerID = SetTimer(0, 0, 100, AddressOf repositionneMsgbox)
    Response = MsgBox(message, style, titre)
    msgboxPos = Response
End Function
Sub repositionneMsgbox()
    Dim posLeft&, PosTop&
    With Application
        posLeft = Int((.Left + ((.Width - 220) / 2)) * (4 / 3)) + 20
        PosTop = Int((.Top + ((.Height - 150) / 2)) * (4 / 3))
    End With
    x = FindWindow(vbNullString, MsgBoxTitle)
    SetWindowPos x, -1, posLeft, PosTop, 220, 150, &H0
    On Error Resume Next
    If timerID <> 0 Then KillTimer 0, timerID: timerID = 0:
End Sub


'exemple de simple msgbox d'avertissement
Sub test2()
    msgboxPos "coucou tout lemonde", vbOK + vbInformation, "messageTest"
End Sub

c'é bo la vie non?
a perfectionner:
par exemple avec api getwindowrect le rectangle du message pour avoir les vrai dimmentions d'orrigine
ici je l'impose a 220 de large et 150 de haut

faut pas m'en vouloir j'ai fait ça en 10 minutes
😉

Bonjour,

Merci de votre retour... je vais voir pour appliquer le code dans mon fichier.

Bien à vous,
Benoît

 

[bouchard]

Bonjour Benoit.
pour un début ,pourquoi pas au plus simple, sans appel au API ni aux bibliothèques,
je te propose un formulaire simple et une fonction MsgboxXY

Public vrep
Function MsgBoxXY(Vmessage, vtitre, vx, vy)
UfMs.Tmessage = Vmessage
UfMs.Caption = vtitre
UfMs.Tx = vx
UfMs.Ty = vy
UfMs.Show
MsgBoxXY = vrep
End Function

Et dans le formulaire, je gère trois évènements

Private Sub CbAnnul_Click()
vrep = "Oui"
Unload UfMs
End Sub

Private Sub CBok_Click()
vrep = "Non"
Unload UfMs
End Sub

Private Sub UserForm_Activate()
UfMs.Left = Application.Left + Val(Tx)
UfMs.Top = Application.Top + Val(Ty)
End Sub

Voici le fichier.
Cdlt

 

[bouchard]

En fait, j'ai inversé les réponses. je te laisse corriger.

 

[patricktoulon]

re
bonjour @bouchard
et si le msgbox doit gerer autre chose que (oui/non) 😉

et si on se donne la peine de chercher

collection fausse boite de dialogue (Patricktoulon) episode 3 un vrai faux msgbox personalisable

bonjour a tous dans la lignée de ma collection de boite de dialogue responsive avec Userform je vous propose aujourd'hui le msgbox perso je l'ai un peu mis a jour et toujours pareil comme le CALENDRIER il suffit d'importer le userform dans votre...

excel-downloads.com

Temporiser le vrai MsgBox de VBA

Bonjour a tous la question revient souvent comment faire un msgbox temporaire il y a diverses façons de procéder la plus courante et connue et le popup de wscript.shell qui possède un argument timeout sauf que ca n'est plus modal et selon les...

excel-downloads.com

VBA - MsgBox personnalisé - MsgBoxPerso avec 0 à 12 boutons (type MsgBox ou textuels), icône & timer

Le fichier à télécharger contient: Le UserForm MsgBoxPerso à importer dans le projet VBA pour utiliser ce MsgBox Personnalisé, Le Module_Test qui donne quelques exemples d'utilisation. L'appel de la fonction: Dim Retour As Variant ' Retour =...

excel-downloads.com

https://excel-downloads.com/threads...ai-msgbox-de-vba-temporise-supprime.20048141/

collection fausse boite de dialogue (Patricktoulon) episode 3 un vrai faux msgbox personalisable

patricktoulon a soumis une nouvelle ressource: collection fausse boite de dialogue (Patricktoulon) episode 3 un vrai faux msgbox personalisable - msgbox perso personnalisable bonjour a tous dans la lignée de ma collection de boite de dialogue responsive avec Userform je vous propose...

excel-downloads.com

 

[bouchard]

Bonne remarque!
je pense que même un débutant qui se donne la peine d'approfondir ce code, sans difficulté, va pouvoir faire évoluer le formulaire et ses évènements. En posant la question, il prouve qu'il est déjà intéressé et motivé.

Bon apprentissage Benoit.