Здравствуйте Чтобы распечатать сообщение в MsgBox, я его копирую комбинацией Ctrl+C, вставляю в какой нибудь документ и потом распечатываю. Пожалуйста, подскажите, как можно сделать в message box кнопку 'Печать', по нажатию которой распечатать текст сообщения?
Здравствуйте Чтобы распечатать сообщение в MsgBox, я его копирую комбинацией Ctrl+C, вставляю в какой нибудь документ и потом распечатываю. Пожалуйста, подскажите, как можно сделать в message box кнопку 'Печать', по нажатию которой распечатать текст сообщения?sashgera
ну какую нибудь кнопку показать можно, например, vbOKOnly, про кнопку Печать понял - нельзя а по нажатию этой копки (OK) можно распечатать текст сообщения?
ну какую нибудь кнопку показать можно, например, vbOKOnly, про кнопку Печать понял - нельзя а по нажатию этой копки (OK) можно распечатать текст сообщения?sashgera
Option Explicit Private Type DOCINFO pDocName As String pOutputFile As String pDatatype As String End Type Private Declare Function ClosePrinter _ Lib "winspool.drv" ( _ ByVal hPrinter As Long _ ) As Long Private Declare Function EndDocPrinter _ Lib "winspool.drv" ( _ ByVal hPrinter As Long _ ) As Long Private Declare Function EndPagePrinter _ Lib "winspool.drv" ( _ ByVal hPrinter As Long _ ) As Long Private Declare Function OpenPrinter _ Lib "winspool.drv" _ Alias "OpenPrinterA" ( _ ByVal pPrinterName As String, _ phPrinter As Long, _ ByVal pDefault As Long _ ) As Long Private Declare Function StartDocPrinter _ Lib "winspool.drv" _ Alias "StartDocPrinterA" ( _ ByVal hPrinter As Long, _ ByVal Level As Long, _ pDocInfo As DOCINFO _ ) As Long Private Declare Function StartPagePrinter _ Lib "winspool.drv" ( _ ByVal hPrinter As Long _ ) As Long Private Declare Function WritePrinter _ Lib "winspool.drv" ( _ ByVal hPrinter As Long, _ pBuf As Any, _ ByVal cdBuf As Long, _ pcWritten As Long _ ) As Long
Public Sub PrintStr(sWrittenData As String, Optional prn As String) Dim lhPrinter As Long Dim lReturn As Long Dim lpcWritten As Long Dim lDoc As Long
Dim MyDocInfo As DOCINFO If Len(prn) = 0 Then prn = ActivePrinter prn = Left(prn, InStr(prn & " (Ne", "(Ne") - 2) lReturn = OpenPrinter(prn, lhPrinter, 0) If lReturn = 0 Then MsgBox "Принтер не найден" Exit Sub End If MyDocInfo.pDocName = "AAAAAA" MyDocInfo.pOutputFile = vbNullString MyDocInfo.pDatatype = vbNullString lDoc = StartDocPrinter(lhPrinter, 1, MyDocInfo) Call StartPagePrinter(lhPrinter) lReturn = WritePrinter(lhPrinter, _ ByVal (sWrittenData & vbFormFeed), _ Len(sWrittenData), lpcWritten) lReturn = EndPagePrinter(lhPrinter) lReturn = EndDocPrinter(lhPrinter) lReturn = ClosePrinter(lhPrinter) End Sub
[/vba]
использование в коде [vba]
Код
call PrintStr("Текст который нужно печатать","Имя принтера")
[/vba] Второй аргумент не обязателен, если его не указывать, будет печататься на активный принтер [vba]
Код
Sub dd() Dim s$ s = "Текст" If MsgBox(s, 4, "Печатать?") = vbYes Then PrintStr s End Sub
[/vba]
можно как-то так
[vba]
Код
Option Explicit Private Type DOCINFO pDocName As String pOutputFile As String pDatatype As String End Type Private Declare Function ClosePrinter _ Lib "winspool.drv" ( _ ByVal hPrinter As Long _ ) As Long Private Declare Function EndDocPrinter _ Lib "winspool.drv" ( _ ByVal hPrinter As Long _ ) As Long Private Declare Function EndPagePrinter _ Lib "winspool.drv" ( _ ByVal hPrinter As Long _ ) As Long Private Declare Function OpenPrinter _ Lib "winspool.drv" _ Alias "OpenPrinterA" ( _ ByVal pPrinterName As String, _ phPrinter As Long, _ ByVal pDefault As Long _ ) As Long Private Declare Function StartDocPrinter _ Lib "winspool.drv" _ Alias "StartDocPrinterA" ( _ ByVal hPrinter As Long, _ ByVal Level As Long, _ pDocInfo As DOCINFO _ ) As Long Private Declare Function StartPagePrinter _ Lib "winspool.drv" ( _ ByVal hPrinter As Long _ ) As Long Private Declare Function WritePrinter _ Lib "winspool.drv" ( _ ByVal hPrinter As Long, _ pBuf As Any, _ ByVal cdBuf As Long, _ pcWritten As Long _ ) As Long
Public Sub PrintStr(sWrittenData As String, Optional prn As String) Dim lhPrinter As Long Dim lReturn As Long Dim lpcWritten As Long Dim lDoc As Long
Dim MyDocInfo As DOCINFO If Len(prn) = 0 Then prn = ActivePrinter prn = Left(prn, InStr(prn & " (Ne", "(Ne") - 2) lReturn = OpenPrinter(prn, lhPrinter, 0) If lReturn = 0 Then MsgBox "Принтер не найден" Exit Sub End If MyDocInfo.pDocName = "AAAAAA" MyDocInfo.pOutputFile = vbNullString MyDocInfo.pDatatype = vbNullString lDoc = StartDocPrinter(lhPrinter, 1, MyDocInfo) Call StartPagePrinter(lhPrinter) lReturn = WritePrinter(lhPrinter, _ ByVal (sWrittenData & vbFormFeed), _ Len(sWrittenData), lpcWritten) lReturn = EndPagePrinter(lhPrinter) lReturn = EndDocPrinter(lhPrinter) lReturn = ClosePrinter(lhPrinter) End Sub
[/vba]
использование в коде [vba]
Код
call PrintStr("Текст который нужно печатать","Имя принтера")
[/vba] Второй аргумент не обязателен, если его не указывать, будет печататься на активный принтер [vba]
Код
Sub dd() Dim s$ s = "Текст" If MsgBox(s, 4, "Печатать?") = vbYes Then PrintStr s End Sub
Ой! Какой кошмар! У меня более рабоче-крестьянский способ, аж стыдно стало [vba]
Код
Sub dd() s = "Текст" If MsgBox(s, 4, "Печатать?") = 6 Then ad_ = Selection.Address With Range("A1").SpecialCells(xlLastCell).Offset(1) .Value = s .PrintOut .Clear End With Range(ad_).Select End If End Sub
[/vba]
Ой! Какой кошмар! У меня более рабоче-крестьянский способ, аж стыдно стало [vba]
Код
Sub dd() s = "Текст" If MsgBox(s, 4, "Печатать?") = 6 Then ad_ = Selection.Address With Range("A1").SpecialCells(xlLastCell).Offset(1) .Value = s .PrintOut .Clear End With Range(ad_).Select End If End Sub
Если сам пишешь код, но не знаешь, понадобится ли в дальнейшем то, что выдал MsgBox, то можно тупо после вывода каждого MsgBox закидывать его текст в буфер обмена, а там уж понадобится/не понадобится. На скорую руку примерно так: [vba]
Код
Sub ttt() Dim sText$: sText = "Text MsgBox" MsgBox (sText) With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"): .SetText sText: .PutInClipboard: End With End Sub
[/vba]
Если сам пишешь код, но не знаешь, понадобится ли в дальнейшем то, что выдал MsgBox, то можно тупо после вывода каждого MsgBox закидывать его текст в буфер обмена, а там уж понадобится/не понадобится. На скорую руку примерно так: [vba]
Код
Sub ttt() Dim sText$: sText = "Text MsgBox" MsgBox (sText) With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"): .SetText sText: .PutInClipboard: End With End Sub