Microsoft 365 MsgBox affichage et fermeture en 1 seconde

[Usine à gaz]

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 ?

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

 

[mapomme]

Bonjour @Usine à gaz
Sans usiner des pets avec le gaz, le plus simple selon ma pomme serait :

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]

Bonjour
Pour utiliser la valeur de la cellule H4 :

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]

Bonjour et Merci mapomme
C'est déjà super pour un dimanche lol

Petite cerise sur le gâteau :
C'est'y possible de supprimer l'espace :

Mais c'est déjà très bien ...
lionel

 

[Usine à gaz]

Bonjour
Pour utiliser la valeur de la cellule H4 :

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 :

Lionel

 

[Dranreb]

Il se trouve que ce sont des "" entre deux vbLf. Alors :

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]

Il se trouve que ce sont des "" entre deux vbLf. Alors :

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

 

[Dranreb]

J'utilise un UserForm non modal pour afficher des choses sans avoir besoin de les valider

 

[Usine à gaz]

Encore Merci @Dranreb
Je garde ...
Mais j'aurais préféré juste avec le MsgBox

 

[Efgé]

Bonjour à tous

Est-il possible de faire en sorte que le MsgBox se ferme dans avoir à cliquer sur "OK" dans 1 seconde ?

CreateObject("Wscript.shell").Popup "Le Message", 1, "Le Titre", 0

Le 1 pour une seconde. Le 0 pour le type de msgbox (voir dans ma signature l'Atelier des MsgBox.

Coridalement

 

[Usine à gaz]

Bonjour Efgé
Merci pour le code et le fichier Atelier_MsgBox_V1 ... Super,
lionel

 

[modus57]

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 :

CreateObject("Wscript.shell").Popup "Le Message", 1, "Le Titre", 0

Faut-il activer une référence ?

 

[patricktoulon]

re
Bonjour
non avec certaines versions de office la partie temporaire de wscript shell ne fonctionne pas
encore une librairie bousillé par MS

 

[modus57]

Bonjour patricktoulon,

Merci pour votre réponse et c'est bien dommage.

Excellente journée.

 

[patricktoulon]

re
je te donne une solution
a savoir temporiser le msgbox (en prevoyant une fermeture à l'avance
par l'api settimer

'
'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

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