Créer un bouton pour imprimer un message box

HamoudaBA

XLDnaute Occasionnel
Bonsoir le fil,
A nouveau je me retourne vers vous pour m'aider une inserer une bouton "imprimer" à un message box qui s'affiche au demarage d'un fichier
si joint une exemple que j'ai trouver sur le forum (un Merci à son auteur).

Je vous remercie.
 

Pièces jointes

  • cdd(2).xlsm
    22.7 KB · Affichages: 36

Dudu2

XLDnaute Barbatruc
Bonjour,

Lorsque le MsgBox s'affiche, il est modal, c'est à dire qu'on n'a pas la main sur Excel et donc un bouton est inaccessible.

Si tu veux le copier dans le presse-papier tu fais <Alt> + touche Imp écran (copier fenêtre active).
Ensuite tu le copies dans ce que tu veux pour l'imprimer.

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.

Une autre possibilité, à supposer que tu aies fait <Alt> + touche Imp écran (copier fenêtre active) au moment de l'affichage du MsgBox, est, après l'affichage du MsgBox, avec un bouton d'envoyer un SendKeys "^v" (coller) sur une feuille vierge puis toujours en VBA de lancer l'impression de cette feuille.

D'ailleurs, puisque le MsgBox est modal, il doit être possible d'envoyer par SendKeys le <Alt> + touche Imp écran (copier fenêtre active) (Application.SendKeys "(%{1068})") par un Timer (qui n'a que faire du modal) pour ensuite avec le bouton proposer l'impression. Je vais essayer ça, mais ce n'est pas du "basique".
 
Dernière édition:

Dudu2

XLDnaute Barbatruc
Voilà, chez moi ça marche.

Avant le MsgBox il faut lancer le Timer dont le rôle est de déclencher un Application.Sendkeys qui va faire l'équivalent d'un Alt + touche Impression Écran (complété d'un NumLock car Application.Sendkeys le dézingue) peu après (300 ms) l'affichage du MsgBox.
VB:
'-------------------------------------
'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

Le Timer va déclencher l'exécution de la fonction CopyActiveWindow:
Code:
'--------------------------------------------
'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

Ensuite y a plus qu'à coller le Clipboard dans une feuille temporaire et à l'imprimer:
Code:
'--------------------------------
'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

Le code contient aussi un Module_Timer que j'ai rendu indépendant pour en faciliter l'utilisation grâce simplement aux paramètres du SetTheTimer(durée en ms, fonction à appeler à échéance du Timer).
 

Pièces jointes

  • Copy & Print MsgBox (using Timer).xlsm
    24.1 KB · Affichages: 9
Dernière édition:

patricktoulon

XLDnaute Barbatruc
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
 
Dernière édition:

Dudu2

XLDnaute Barbatruc
Bonjour les lève-tôt,

Dois-je re-préciser ce que j'avais écrit en Post #2 ?
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.

Mais pourquoi ne pas essayer des choses différentes et ne pas céder à la facilité ?
Et puis, avec la récupération du texte, qui c'est qui va le mettre en forme comme le MsgBox ?
Alors c'est qui qui ?
« think different !! » ; j'adore !!!
Moi aussi ;)
 

Dudu2

XLDnaute Barbatruc
MsgBox décide des retours lignes selon ses contraintes propres que tu ne peux pas reproduire.
Il se trouve qu'en l'occurrence ça matche lorsque tu imprimes le texte (et encore faut voir les décalages dus à la police) mais c'est juste un coup de bol :p
Et puis tu n'as pas imprimé le titre que de toutes façons tu ne peux pas formater comme dans le MsgBox.
Ne me dis pas que ça:
2020-11-26_072844.jpg

c'est pareil que ça:
2020-11-26_072747.jpg

Ou alors faut retirer les lunettes de soleil :cool: :)
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
ma fois
Capture.JPG

peut être a tu des paramètres modifiés dans ton bloknote que tu n'a pas réinitialisé
moi je n'en vois pas
il n'y a aucune raison pour que le texte soit différent ca je peux le garantir la seul chose qui peut faire la différence c'est si tu a changé le font dans ton bloknote ;d'origine c'est calibri aussi comme excel
dans ce cas tu est seul responsable de cette erreur
think différent!!
 

Dudu2

XLDnaute Barbatruc
VB:
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
2020-11-26_074908.jpg

Dans ton fichier texte, tu le sais comment que MsgBox coupe entre azeaz et erz ?
Et puis dans ton fichier texte tu n'as toujours pas la jolie ligne titre en bleu dans un joli cadre bleu 😍.
Tu veux que je te dise ? Il est triste ton fichier texte 😭
Be Happy !
 

patricktoulon

XLDnaute Barbatruc
🤪

c'est de l'impression LIDL
Allez fait toi plaisir refait la même chose sur une feuille temporaire met de la couleur et un sapin de noel ,des guirlandes ,des loupiottes

et profite en pour commander des cartouches pour ton imprimante 😁🤪😂😇🥳

pour info quand j'imprime un texte au minimum je le tructure je ne compte pas sur la chance que le wraptext me sorte structuré comme je le souhaite
think différent!!!
 

Dudu2

XLDnaute Barbatruc
🥰 j'adore nos discussions sur le thème "ma solution est meilleure", et les faire durer.
Pour revenir au réel, et pour HamoudaBA, il est certain que la solution du texte est de loin la plus simple surtout avec la mise en œuvre que tu proposes.
J'ai fait la bidouille Copy / Paste du MsgBox histoire de faire un truc pas ordinaire et voir si ça pouvait marcher.
 

patricktoulon

XLDnaute Barbatruc
re
ha ben ca marche je te confirme
je pense pas que l'on puisse mesurer quelle est la meilleure

quand je répond je prend en compte le demandeur
visiblement @HamoudaBA travaille dans une université
je pense que cette université pense aussi a l'économie

au vue de ces posts précédent je pense pas qu'il soit au niveau d'utiliser certaines api
et d'autant plus une des plus dangereuse quand elle est pas maîtrisée (tu en conviendra)

donc muni de tout ces paramètres j'offre une solution la plus adaptée
c'est ça être une meilleures réponse ;) c'est pas le code ou la méthode en elle même

et oui nos joutes sont pour moi un plaisir car inversement a d'autres ça ce passe dans la bonne humeur et humour et quand tu a raison je l'accepte volontiers et je pense que c'est réciproque
 

HamoudaBA

XLDnaute Occasionnel
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
Bonjour cher patricktoulon,
Châpeau bas cher Monsieur, c'est bien ce que je voulais.
Encore MERCI a vous tous.
 

Discussions similaires

Réponses
4
Affichages
176
Réponses
16
Affichages
431