'***************************************************************************************************************************
'**********************************************************************************
' __ _____ ___ . ___ _____ ___ ___
'|__| /\ | | | | | | / | | | | | | | | |\ |
'| /__\ | |--- | | |/\ | | | | | | | | | \ |
'| / \ | | \ | |___ | \ | |___| |___| |__ |___| | \|
'
'***********************************************************************************
' 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
. Je vais approfondir la chose.
