'-------------------------------------
'Affiche un MsgBox et copie sa fenêtre
'-------------------------------------
Sub CopyMsgBox()
'Lance le Timer
Call SetTheTimer(300, "CopyActiveWindow")
'Affiche le MsgBox
MsgBox ("Message affiché par MsgBox")
End Sub
'--------------------------------------------
'Fonction applicative déclenchée par le Timer
'Copie la fenêtre active du MsgBox
'--------------------------------------------
Sub CopyActiveWindow()
'Envoi de Alt + Impression Écran (copier fenêtre active)
Application.SendKeys "%{1068}{NUMLOCK}"
End Sub
'--------------------------------
'Créé une feuille temporaire pour
'y coller et imprimer le MsgBox
'--------------------------------
Sub PrintMsgBox()
Dim WS As Worksheet
'Inhibe l'affichage
Application.ScreenUpdating = False
'Ajoute une feuille temporaire
Set WS = ThisWorkbook.Worksheets.Add
'Colle la fenêtre copiée du MsgBox
CreateObject("wscript.shell").SendKeys ("^v") 'N'impacte pas le clavier numérique
DoEvents
'Imprime
WS.PrintOut
'Supprime la feuille temporaire
Application.DisplayAlerts = False
WS.Delete
Application.DisplayAlerts = True
'Désinhibe l'affichage
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_Open()
Dim tablo, Limite As Integer, Alerte As Integer, Chaine As String
Limite = 90 ' Définit la limite qui déclenche l'alerte, ici 90 jours
Alerte = 30 ' Définit la limite qui déclenche l'alerte supplémentaire si <30 jours
tablo = Sheets("CDD").Range("A2").CurrentRegion
Chaine = ""
For i = 1 To UBound(tablo)
If tablo(i, 6) <= Limite And tablo(i, 6) > Alerte Then
Chaine = Chaine & tablo(i, 2) & vbTab & " CDD expire dans " & tablo(i, 6) & " jours." & Chr(10)
End If
If tablo(i, 6) <= Limite And tablo(i, 6) <= Alerte Then
Chaine = Chaine & tablo(i, 2) & vbTab & " CDD expire dans " & tablo(i, 6) & " jours." & vbTab & "Attention, moins d'un mois" & Chr(10)
End If
If tablo(i, 6) = "CDD échu" Then
Chaine = Chaine & tablo(i, 2) & vbTab & " CDD échu " & Chr(10)
End If
Next i
'M = MsgBox(Chaine, , "CDD expirant dans moins de " & Limite & " jours.")
nom = "liste des CDD expirant dans moins de " & Limite & " jours.txt"
Fichier = Environ("userprofile") & "\Desktop\" & nom
x = FreeFile: Open Fichier For Output As #x: Print #x, Replace(Chaine, Chr(10), vbCrLf): Close #x
CreateObject("Shell.Application").Namespace(0).ParseName(Fichier).InvokeVerb ("Print")
Application.Wait (Now + TimeValue("0:00:03"))
'kill fichier'si tu ne veux pas le garder
End Sub
En VBA il te reste la possibilité, avant ou après l'affichage du MsgBox, de récupérer le texte qui lui a été passé pour le copier ailleurs, sur une feuille vierge par exemple, puis de lancer l'impression de cette feuille.
Moi aussi« think different !! » ; j'adore !!!
allons @Dudu2 voyons depuis quand y a t il un format quelconque envoyé dan un msgbox ?t puis, avec la récupération du texte, qui c'est qui va le mettre en forme comme le MsgBox ?
Sub a()
MsgBox " zef azzf azerf arerae rgerg zergze gzer rgzerg zef zerze azer az azeraz erz azer azerazer azer azer azeazeraz erzer az"
End Sub
Bonjour cher patricktoulon,re
bonjour @Dudu2 @HamoudaBA
alors ou c'est moi qui n'est pas bien réveillé ou c'est vous
au départ perso la première question est
pourquoi enregistrer le texte d'un message en image ??
ou est l’intérêt????
pourquoi ne pas imprimer ce texte directement ? en text bien sur
donc !! @HamoudaBA @Dudu2
je reprend l'exemple de @HamoudaBA
et je le sauve en texte et l’imprime
VB:Private Sub Workbook_Open() Dim tablo, Limite As Integer, Alerte As Integer, Chaine As String Limite = 90 ' Définit la limite qui déclenche l'alerte, ici 90 jours Alerte = 30 ' Définit la limite qui déclenche l'alerte supplémentaire si <30 jours tablo = Sheets("CDD").Range("A2").CurrentRegion Chaine = "" For i = 1 To UBound(tablo) If tablo(i, 6) <= Limite And tablo(i, 6) > Alerte Then Chaine = Chaine & tablo(i, 2) & vbTab & " CDD expire dans " & tablo(i, 6) & " jours." & Chr(10) End If If tablo(i, 6) <= Limite And tablo(i, 6) <= Alerte Then Chaine = Chaine & tablo(i, 2) & vbTab & " CDD expire dans " & tablo(i, 6) & " jours." & vbTab & "Attention, moins d'un mois" & Chr(10) End If If tablo(i, 6) = "CDD échu" Then Chaine = Chaine & tablo(i, 2) & vbTab & " CDD échu " & Chr(10) End If Next i 'M = MsgBox(Chaine, , "CDD expirant dans moins de " & Limite & " jours.") nom = "liste des CDD expirant dans moins de " & Limite & " jours.txt" Fichier = Environ("userprofile") & "\Desktop\" & nom x = FreeFile: Open Fichier For Output As #x: Print #x, Replace(Chaine, Chr(10), vbCrLf): Close #x CreateObject("Shell.Application").Namespace(0).ParseName(Fichier).InvokeVerb ("Print") Application.Wait (Now + TimeValue("0:00:03")) 'kill fichier'si tu ne veux pas le garder End Sub
bonne nuit
think different !!
mais c'est bien joué @Dudu2 le sendkeys en adressof par le timer
comme je l'ai dis précédemment le seul moyen propre de faire du multithread en VBA à part le vbs externe