Microsoft 365 MsgBox affichage et fermeture en 1 seconde

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous,
Je vous souhaite un beau dimanche :)

J'en ai une petit pour ce dimanche lol :)
Ce sont patricktoulon et mapomme qui vont être contents 😁😂🤣

Est-il possible de faire ça ?
1653818251199.png

Le but est de supprimer Microsoft Excel et de mettre la 1ère ligne en titre
Je cherche mais j'ai pas encore trouvé Grrr !!!!

Je joins un petit fichier test ...
Juste avec le MsgBox, sans UserForm ou autre qui alourdiraient mes Usine à Gaz ...
Auriez-vous la solution ?
Merci à toutes et à tous,
lionel :)
 

Pièces jointes

  • MsgBox.xlsm
    61 KB · Affichages: 13
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @Usine à gaz :)
Sans usiner des pets avec le gaz, le plus simple selon ma pomme serait :
VB:
Sub test()
Const Citation = "Magie universelle§De quelques lettres assemblées§Pour dire l'espoir tenace§De milliers d'êtres sur la terre§Qui crient à tous les vents :§Pax, paix, pace, peace, paco ...§§Mais, si l'écho fidèle§Sur un rocher répercute§Un appel pathétique,§L'espoir se heurte aux murs§De la haine et de l'intolérance§Et nous revient impuissant,§Ou bien se perd, angoissé,§Dans le tonnerre des batailles,§Les ruines des villes en guerre,§Ou les déserts des famines§§Pourtant, comme le phénix,§L'espoir renaît plus fort§Car des hommes s'unissent§Et forgent des trompettes§Pour d 'autres Jericho.§§Mathilde LE MOAL  Guingamp (22)"
   MsgBox Replace(Citation, "§", Chr(10)), , "PAIX"
End Sub
 

Dranreb

XLDnaute Barbatruc
Bonjour
Pour utiliser la valeur de la cellule H4 :
VB:
Private Sub Worksheet_SelectionChange(ByVal R As Range)
   Dim TSpl() As String, Titre As String, P As Byte
   If Not Intersect(R, Me.[H4]) Is Nothing Then
       TSpl = Split(Me.[H4].Value, vbLf)
       Titre = TSpl(0)
       For P = 0 To UBound(TSpl) - 1: TSpl(P) = TSpl(P + 1): Next P
       ReDim Preserve TSpl(0 To UBound(TSpl) - 1)
       MsgBox Prompt:=Join(TSpl, vbLf), Title:=Titre
       End If
   End Sub
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour
Pour utiliser la valeur de la cellule H4 :
VB:
Private Sub Worksheet_SelectionChange(ByVal R As Range)
   Dim TSpl() As String, Titre As String, P As Byte
   If Not Intersect(R, Me.[H4]) Is Nothing Then
       TSpl = Split(Me.[H4].Value, vbLf)
       Titre = TSpl(0)
       For P = 0 To UBound(TSpl) - 1: TSpl(P) = TSpl(P + 1): Next P
       ReDim Preserve TSpl(0 To UBound(TSpl) - 1)
       MsgBox Prompt:=Join(TSpl, vbLf), Title:=Titre
       End If
   End Sub
Bonjour Dranreb :)
Merci pour ton code également très bien :)
Même question que pour Mapomme :
Petite cerise sur le gâteau :
C'est'y possible de supprimer l'espace :
1653821457907.png

Lionel :)
 

Dranreb

XLDnaute Barbatruc
Il se trouve que ce sont des "" entre deux vbLf. Alors :
VB:
Private Sub Worksheet_SelectionChange(ByVal R As Range)
   Dim TSpl() As String, Titre As String, P As Byte
   If Not Intersect(R, Me.[H4]) Is Nothing Then
       TSpl = Split(Me.[H4].Value, vbLf)
       Titre = TSpl(0)
       For P = 0 To UBound(TSpl) - 2: TSpl(P) = TSpl(P + 2): Next P
       ReDim Preserve TSpl(0 To UBound(TSpl) - 2)
       MsgBox Prompt:=Join(TSpl, vbLf), Title:=Titre
       End If
   End Sub
Mais il y a apparemment un espace entre de titre et le début du texte qu'on ne peut pas réduire d'avantage.
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Il se trouve que ce sont des "" entre deux vbLf. Alors :
VB:
Private Sub Worksheet_SelectionChange(ByVal R As Range)
   Dim TSpl() As String, Titre As String, P As Byte
   If Not Intersect(R, Me.[H4]) Is Nothing Then
       TSpl = Split(Me.[H4].Value, vbLf)
       Titre = TSpl(0)
       For P = 0 To UBound(TSpl) - 2: TSpl(P) = TSpl(P + 2): Next P
       ReDim Preserve TSpl(0 To UBound(TSpl) - 2)
       MsgBox Prompt:=Join(TSpl, vbLf), Title:=Titre
       End If
   End Sub
Mais il y a apparemment un espace entre de titre et le début du texte qu'on ne peut pas réduire d'avantage.
Merci @Dranreb :)

J'en ai une petite dernière pour ce fil :
Dans mes "usines à gaz", j'ai beaucoup de MsgBox qu'il faut fermer en cliquant sur "OK".
= beaucoup de clics.
Est-il possible de faire en sorte que le MsgBox se ferme dans avoir à cliquer sur "OK" dans 1 seconde ?
L'idéal serait que le "OK" n'apparaisse pas.

Mais ça, c'est'y possible ???
lionel :)
 

modus57

XLDnaute Occasionnel
Bonjour,

L'idée d'un message temporaire est intéressante j'essaye de l'utiliser de cette manière mais le message est permanent :
VB:
CreateObject("Wscript.shell").Popup "Le Message", 1, "Le Titre", 0
Faut-il activer une référence ?
 

patricktoulon

XLDnaute Barbatruc
re
je te donne une solution
a savoir temporiser le msgbox (en prevoyant une fermeture à l'avance
par l'api settimer
VB:
'
'MODELE PATRICKTOULON
'======================================================
'       !! TEMPORISER LE VRAI MSGBOX DE VBA !!
'catégorie boite de dialogue
'Temporisation du vrai msgbox de vba
'Auteurs:patricktoulon sur exceldownload
'Version :1.0; de patricktoulon
'Utilisation des api setTimer et KillTimer
'======================================================

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
#Else
    Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
    Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If
Dim MsgBoxTitle
Dim MsgBoxCloseD As Boolean
Dim TimerID&

Sub test1()
MsgBoxX "le message", vbOKOnly, "letitre", DelayOfResponse:=2
End Sub

Function MsgBoxX( _
         message As String, _
         Optional style As VbMsgBoxStyle = vbOKOnly, _
         Optional titre As String = "", _
         Optional helper As String = "", _
         Optional ByVal contexte As Long = 0, _
         Optional ResponseByDefault As Boolean = False, _
         Optional DelayOfResponse As Long = 0)

    Dim Response$
    titre = IIf(titre = "", "Message Excel!", titre)
    MsgBoxTitle = titre: MsgBoxCloseD = False:
    If DelayOfResponse > 0 Then TimerID = SetTimer(0, 0, DelayOfResponse * 1000, AddressOf CloseMsgBox)
    Response = MsgBox(message, style, titre, helper, contexte)
    If TimerID <> 0 Then KillTimer 0, TimerID: TimerID = 0:
    'réponse "timeout!!" ou le bouton par defaut selon l'argument "ResponseByDefault"
    If MsgBoxCloseD And Not ResponseByDefault Then Response = "timeOut!!"
    MsgBoxX = Response
End Function

bien sur cette fonction peut repondre comme un msgbox en mode response
VB:
Sub test2()
Dim x
x = MsgBoxX("le message", vbYesNo, "letitre", DelayOfResponse:=2)
Select Case x
Case vbYes: MsgBox "vous avez repondu oui"
Case vbNo: MsgBox "vous avez repondu non"
End Select
End Sub
bonne journée ;)
 

Discussions similaires

Statistiques des forums

Discussions
311 721
Messages
2 081 927
Membres
101 842
dernier inscrit
seb0390