khoavu87
Vũ Trần Khoa
- Tham gia
- 5/3/09
- Bài viết
- 1,311
- Được thích
- 1,769
- Nghề nghiệp
- Kỹ Sư Xây dựng cầu đường
Option Explicit
Const PRINTER_ENUM_CONNECTIONS = &H4
Const PRINTER_ENUM_LOCAL = &H2
Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" _
(ByVal flags As Long, ByVal name As String, ByVal Level As Long, _
pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, _
pcReturned As Long) As Long
Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyA" _
(ByVal RetVal As String, ByVal Ptr As Long) As Long
Private Declare Function StrLen Lib "kernel32" Alias "lstrlenA" _
(ByVal Ptr As Long) As Long
'\\------------------------------------------------------------------------------------
Public Function ListPrinters() As Variant
Dim bSuccess As Boolean
Dim iBufferRequired As Long
Dim iBufferSize As Long
Dim iBuffer() As Long
Dim iEntries As Long
Dim iIndex As Long
Dim strPrinterName As String
Dim iDummy As Long
Dim iDriverBuffer() As Long
Dim StrPrinters() As String
iBufferSize = 3072
ReDim iBuffer((iBufferSize \ 4) - 1) As Long
'EnumPrinters will return a value False if the buffer is not big enough
bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
PRINTER_ENUM_LOCAL, vbNullString, _
1, iBuffer(0), iBufferSize, iBufferRequired, iEntries)
If Not bSuccess Then
If iBufferRequired > iBufferSize Then
iBufferSize = iBufferRequired
Debug.Print "iBuffer too small. Trying again with "; _
iBufferSize & " bytes."
ReDim iBuffer(iBufferSize \ 4) As Long
End If
'Try again with new buffer
bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
PRINTER_ENUM_LOCAL, vbNullString, _
1, iBuffer(0), iBufferSize, iBufferRequired, iEntries)
End If
If Not bSuccess Then
'Enumprinters returned False
MsgBox "Error enumerating printers."
Exit Function
Else
'Enumprinters returned True, use found printers to fill the array
ReDim StrPrinters(iEntries - 1)
For iIndex = 0 To iEntries - 1
'Get the printername
strPrinterName = Space$(StrLen(iBuffer(iIndex * 4 + 2)))
iDummy = PtrToStr(strPrinterName, iBuffer(iIndex * 4 + 2))
StrPrinters(iIndex) = strPrinterName
Next iIndex
End If
ListPrinters = StrPrinters
End Function
'\\------------------------------------------------------------------------------------
''You could call the function as follows:
Public Function IsBounded(vArray As Variant) As Boolean
''If the variant passed to this function is an array, the function will return True;
''otherwise it will return False
On Error Resume Next
IsBounded = IsNumeric(UBound(vArray))
End Function
Và Code cho Form:
Private Sub cmdPrint_Click()
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:=Me.cboPrintList.Value, Collate:=True
End Sub
Private Sub UserForm_Activate()
cboPrintList.ColumnCount = 1
cboPrintList.ColumnHeads = False
Dim StrPrinters As Variant, iRow As Long
StrPrinters = ListPrinters
If IsBounded(StrPrinters) Then
For iRow = LBound(StrPrinters) To UBound(StrPrinters)
cboPrintList.AddItem StrPrinters(iRow)
Next iRow
End If
End Sub
mình thấy trên diễn đàn có code chọn máy in rất hay (đã làm thành công), bạn có thể tham khảo. Còn mình nghĩ nếu in dữ liệu trong listbox có thể rút trích ra cells sau đó set print area cho code là được
Mã:Option Explicit Const PRINTER_ENUM_CONNECTIONS = &H4 Const PRINTER_ENUM_LOCAL = &H2 Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" _ (ByVal flags As Long, ByVal name As String, ByVal Level As Long, _ pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, _ pcReturned As Long) As Long Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyA" _ (ByVal RetVal As String, ByVal Ptr As Long) As Long Private Declare Function StrLen Lib "kernel32" Alias "lstrlenA" _ (ByVal Ptr As Long) As Long '\\------------------------------------------------------------------------------------ Public Function ListPrinters() As Variant Dim bSuccess As Boolean Dim iBufferRequired As Long Dim iBufferSize As Long Dim iBuffer() As Long Dim iEntries As Long Dim iIndex As Long Dim strPrinterName As String Dim iDummy As Long Dim iDriverBuffer() As Long Dim StrPrinters() As String iBufferSize = 3072 ReDim iBuffer((iBufferSize \ 4) - 1) As Long 'EnumPrinters will return a value False if the buffer is not big enough bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _ PRINTER_ENUM_LOCAL, vbNullString, _ 1, iBuffer(0), iBufferSize, iBufferRequired, iEntries) If Not bSuccess Then If iBufferRequired > iBufferSize Then iBufferSize = iBufferRequired Debug.Print "iBuffer too small. Trying again with "; _ iBufferSize & " bytes." ReDim iBuffer(iBufferSize \ 4) As Long End If 'Try again with new buffer bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _ PRINTER_ENUM_LOCAL, vbNullString, _ 1, iBuffer(0), iBufferSize, iBufferRequired, iEntries) End If If Not bSuccess Then 'Enumprinters returned False MsgBox "Error enumerating printers." Exit Function Else 'Enumprinters returned True, use found printers to fill the array ReDim StrPrinters(iEntries - 1) For iIndex = 0 To iEntries - 1 'Get the printername strPrinterName = Space$(StrLen(iBuffer(iIndex * 4 + 2))) iDummy = PtrToStr(strPrinterName, iBuffer(iIndex * 4 + 2)) StrPrinters(iIndex) = strPrinterName Next iIndex End If ListPrinters = StrPrinters End Function '\\------------------------------------------------------------------------------------ ''You could call the function as follows: Public Function IsBounded(vArray As Variant) As Boolean ''If the variant passed to this function is an array, the function will return True; ''otherwise it will return False On Error Resume Next IsBounded = IsNumeric(UBound(vArray)) End Function Và Code cho Form: Private Sub cmdPrint_Click() ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:=Me.cboPrintList.Value, Collate:=True End Sub Private Sub UserForm_Activate() cboPrintList.ColumnCount = 1 cboPrintList.ColumnHeads = False Dim StrPrinters As Variant, iRow As Long StrPrinters = ListPrinters If IsBounded(StrPrinters) Then For iRow = LBound(StrPrinters) To UBound(StrPrinters) cboPrintList.AddItem StrPrinters(iRow) Next iRow End If End Sub
Thế sao bạn không đơn giản hóa vấn đề: Xuất từ ListBox ra 1 vùng rồi in vùng đó?bản chất là em đã đưa dữ liệu từ ex lên nên nếu in thì có thể in ở vùng dữ liệu đó. Mục đích của em muốn in trực tiếp trên Form luôn. Nếu có thể mong A gửi file lên em tham khảo với ạ.
Public Oldcolor
'-------------------------------------------------------
Private Sub CommandButton1_Click()
Hide_Show False
Me.PrintForm
Hide_Show True
End Sub
'--------------------------------------------------------
Sub Hide_Show(Cd As Boolean)
Dim ctr As Control
If Cd = False Then Oldcolor = Me.BackColor
For Each ctr In Me.Controls
If ctr.Name <> Me.ListBox1.Name Then ctr.Visible = Cd
Next
Me.BackColor = IIf(Cd, Oldcolor, &H80000014)
End Sub
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2