Msgbox ausdrucken

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Walter,
dein Codefragment so.
Dim strT As String, zz As Long

With Sheets("Druck_Geburstag")
    For zz = 3 To .Cells(.Rows.Count, 1).End(xlUp).Row
        If Not IsEmpty(.Cells(zz, 1)) Then
            If strT <> "" Then strT = strT & vbLf
            strT = strT & .Cells(zz, 1) & " / " & .Cells(zz, 6) _
                & " / " & .Cells(zz, 21) _
                & " "
        End If
    Next
End With

If strT <> "" Then
    If MsgBox("Das sind die Gebursttage von HEUTE: " & Chr(13) & Chr(13) _
        & strT & " " & Chr(13) _
        & " " & _
        " " & Chr(13) & Chr(13) & _
        "Diese Daten ausdrucken ? ", _
        vbYesNo + 64, "Die Geburtstage HEUTE: ") = vbYes Then

        msgbox_Print strT

    End If
End If

und diese Prozedur in ein separates Modul.
Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long

Private Declare Function GetTempFilename Lib "kernel32" Alias _
    "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, _
    ByVal wUnique As Long, ByVal lpTempFileName As String) As Long

Private Declare Function GetTempPath Lib "kernel32.dll" Alias "GetTempPathA" _
    (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Function TextFileTempFilename(Optional Path As String, Optional suffix As String) As String
Dim myTempFileName As String
Dim RetVal As Long

If Path = "" Then
    Path = Space$(256)
    RetVal = GetTempPath(Len(Path), Path)
    Path = Left$(Path, RetVal)
End If

myTempFileName = Space$(256)

Call GetTempFilename(Path, "txt", 0&, myTempFileName)

myTempFileName = Left$(myTempFileName, InStr(myTempFileName, Chr$(0)) - 1)
If suffix <> "" Then
    myTempFileName = Replace(myTempFileName, "tmp", suffix)
End If
TextFileTempFilename = myTempFileName

End Function

Sub msgbox_Print(ByVal strMsg As String)
Dim strFile As String, F As Integer

strFile = TextFileTempFilename(, "txt")
F = FreeFile
Open strFile For Output As #F
Print #F, strMsg
Close #F
ShellExecute 0, "Print", strFile, "", "", 0
Sleep 5000
Kill strFile

End Sub

Gruß Sepp

Hallo Walter,
nicht genauso, aber mit ein bisschen API-Gedöns:

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Declare Function MapVirtualKey Lib "user32.dll" Alias "MapVirtualKeyA" ( _
    ByVal wCode As Long, _
    ByVal wMapType As Long) As Long
Private Declare Sub keybd_event Lib "user32.dll" ( _
    ByVal bVk As Byte, _
    ByVal bScan As Byte, _
    ByVal dwFlags As Long, _
    ByVal dwExtraInfo As Long)
Private Declare Sub Sleep Lib "kernel32.dll" ( _
    ByVal dwMilliseconds As Long)
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 FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

Private Const GC_CLASSNAMEMSEXCEL = "XLMAIN"
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_MENU = &H12

Private hWnd As Long

Private Sub prcPrintMsgBox()
    Dim intAltScan As Integer, intIndex As Integer
    Call prcStopTimer
    Application.ScreenUpdating = False
    intAltScan = MapVirtualKey(VK_MENU, 0&)
    keybd_event VK_MENU, intAltScan, 0&, 0&
    keybd_event vbKeySnapshot, 0&, 0&, 0&
    DoEvents
    keybd_event VK_MENU, intAltScan, KEYEVENTF_KEYUP, 0&
    ThisWorkbook.Worksheets.Add
    With ActiveSheet
        .Paste
        .PrintOut
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
    Application.ScreenUpdating = True
End Sub

Private Sub prcStopTimer()
    Call KillTimer(hWnd, 0)
End Sub

Public Sub test()
    hWnd = FindWindow(GC_CLASSNAMEMSEXCEL, Application.Caption)
    Call SetTimer(hWnd, 0, 100, AddressOf prcPrintMsgBox)
    MsgBox "Hallo Walter," & vbLf & "Ich druck mich jetzt mal." & _
        vbLf & vbLf & "Deine MsgBox", vbOKOnly, "MsgBox drucken"
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Msgbox ausdrucken

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread