Maika8008
Thành viên gạo cội
- Tham gia
- 12/6/20
- Bài viết
- 4,763
- Được thích
- 5,719
- Donate (Momo)
- Giới tính
- Nam
Code này tôi sưu tầm để trả lời cho 1 bạn nhưng tôi thấy cần đưa thành 1 bài riêng để tiện cho các thành viên tìm kiếm sử dụng cho công việc khi cần. Tôi đã test thành công ở sub TestIn2Mat: Đặt trạng thái in 2 măt, in tất cả các sheet cần in (với mỗi sheet cứ có trang lẻ là in sang tờ mới), trả lại trạng thái in 1 mặt cho máy in.
Thay tên "Brother MFC-L2700DW" bằng tên máy in 2 mặt của bạn.
Update: theo bác ndu96081631 thì tôi sửa lại khai báo 1 chút và đã test trên Office 32bit. Còn ai dùng 64bit thì cùng tìm cách sử dụng với các hàm khai báo cho 64bit nhé. Tôi không dùng 64bit nên chịu.
Thay tên "Brother MFC-L2700DW" bằng tên máy in 2 mặt của bạn.
Update: theo bác ndu96081631 thì tôi sửa lại khai báo 1 chút và đã test trên Office 32bit. Còn ai dùng 64bit thì cùng tìm cách sử dụng với các hàm khai báo cho 64bit nhé. Tôi không dùng 64bit nên chịu.
PHP:
Public Type PRINTER_INFO_9
pDevmode As Long '''' POINTER TO DEVMODE
End Type
Public Type DEVMODE
dmDeviceName As String * 32
dmSpecVersion As Integer: dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * 32
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
dmICMMethod As Long
dmICMIntent As Long
dmMediaType As Long
dmDitherType As Long
dmReserved1 As Long
dmReserved2 As Long
End Type
Public Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, buffer As Long, ByVal pbSize As Long, pbSizeNeeded As Long) As Long
Public Declare Function SetPrinter Lib "winspool.drv" Alias "SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, ByVal Command As Long) As Long
Public Declare Function DocumentProperties Lib "winspool.drv" Alias "DocumentPropertiesA" (ByVal hWnd As Long, ByVal hPrinter As Long, ByVal pDeviceName As String, _
ByVal pDevModeOutput As Long, ByVal pDevModeInput As Long, _
ByVal fMode As Long) As Long
'---------- Khai bao 64 bit
Private Declare PtrSafe Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As LongPtr, pDefault As Any) As Long 'PRINTER_DEFAULTS
Private Declare PtrSafe Function GetPrinterDriver Lib "winspool.drv" Alias "GetPrinterDriverA" (ByVal hPrinter As LongPtr, ByVal pEnvironment As String, ByVal Level As Long, pDriverInfo As Byte, ByVal cdBuf As Long, pcbNeeded As Long) As Long
Private Declare PtrSafe Function SetPrinterData Lib "winspool.drv" Alias "SetPrinterDataA" (ByVal hPrinter As LongPtr, ByVal pValueName As String, ByVal dwType As Long, pData As Byte, ByVal cbData As Long) As Long
Private Declare PtrSafe Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As LongPtr) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
Public Const DM_IN_BUFFER = 8
Public Const DM_OUT_BUFFER = 2
Public Sub SetPrinterProperty(ByVal sPrinterName As String, ByVal iPropertyType As Long)
Dim PrinterName, sPrinter, sDefaultPrinter As String
Dim Pinfo9 As PRINTER_INFO_9
Dim hPrinter, nRet As Long
Dim yDevModeData() As Byte
Dim dm As DEVMODE
'sPrinterName = "Brother MFC-L2700DW series"
'''' STROE THE CURRENT DEFAULT PRINTER
sDefaultPrinter = sPrinterName
'''' USE THE FULL PRINTER ADDRESS TO GET THE ADDRESS AND NAME MINUS THE PORT NAME
PrinterName = Left(sDefaultPrinter, InStr(sDefaultPrinter, " on ") - 1)
'''' OPEN THE PRINTER
nRet = OpenPrinter(PrinterName, hPrinter, ByVal 0&)
'''' GET THE SIZE OF THE CURRENT DEVMODE STRUCTURE
nRet = DocumentProperties(0, hPrinter, PrinterName, 0, 0, 0)
If (nRet < 0) Then MsgBox "Cannot get the size of the DEVMODE structure.": Exit Sub
'''' GET THE CURRENT DEVMODE STRUCTURE
ReDim yDevModeData(nRet + 100) As Byte
nRet = DocumentProperties(0, hPrinter, PrinterName, VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER)
If (nRet < 0) Then MsgBox "Cannot get the DEVMODE structure.": Exit Sub
'''' COPY THE CURRENT DEVMODE STRUCTURE
Call CopyMemory(dm, yDevModeData(0), Len(dm))
'''' CHANGE THE DEVMODE STRUCTURE TO REQUIRED
dm.dmDuplex = iPropertyType ' 1 = simplex, 2 = duplex
'''' REPLACE THE CURRENT DEVMODE STRUCTURE WITH THE NEWLEY EDITED
Call CopyMemory(yDevModeData(0), dm, Len(dm))
'''' VERIFY THE NEW DEVMODE STRUCTURE
nRet = DocumentProperties(0, hPrinter, PrinterName, VarPtr(yDevModeData(0)), VarPtr(yDevModeData(0)), DM_IN_BUFFER Or DM_OUT_BUFFER)
Pinfo9.pDevmode = VarPtr(yDevModeData(0))
'''' SET THE DEMODE STRUCTURE WITH ANY CHANGES MADE
nRet = SetPrinter(hPrinter, 9, Pinfo9, 0)
If (nRet <= 0) Then MsgBox "Cannot set the DEVMODE structure.": Exit Sub
'''' CLOSE THE PRINTER
nRet = ClosePrinter(hPrinter)
'''' GET THE FULL PRINTER NAME FOR THE CUTE PDF WRITER
sPrinter = GetPrinterFullName("Microsoft Print to PDF")
'''' CHECK TO MAKE SURE THE CUTEPDF WAS FOUND
If sPrinter <> vbNullString Then
'''' THIS FORCES EXCEL TO ACCEPT THE NEW CHANGES THAT HAVE BEEN MADE TO THE PRINTER SETTINGS
'''' SET THE ACTIVE PRINTER TEMPERARILLY TO THE CUTE PDF WRITER
Application.ActivePrinter = sPrinter
'''' SET THE PRINTER BACK TO THE DEFAULY FOLLOW ME.
Application.ActivePrinter = sDefaultPrinter
End If
End Sub
Public Sub SetDuplex(ByVal sPrinterName As String, iDuplex As Long)
SetPrinterProperty sPrinterName, iDuplex
End Sub
Public Sub SetSimplex(ByVal sPrinterName As String, iDuplex As Long)
SetPrinterProperty sPrinterName, iDuplex
End Sub
Public Function GetPrinterFullName(Printer As String) As String
' This function returns the full name of the first printerdevice that matches Printer.
' Full name is like "PDFCreator on Ne01:" for a English Windows and like
' "PDFCreator sur Ne01:" for French.
' Created: Frans Bus, 2015. See http://pixcels.nl/set-activeprinter-excel
' see http://blogs.msdn.com/b/alejacma/archive/2008/04/11/how-to-read-a-registry-key-and-its-values.aspx
' see http://www.experts-exchange.com/Software/Microsoft_Applications/Q_27566782.html
Const HKEY_CURRENT_USER = &H80000001
Dim regobj As Object
Dim aTypes As Variant
Dim aDevices As Variant
Dim vDevice As Variant
Dim sValue As String
Dim v As Variant
Dim sLocaleOn As String
' get locale "on" from current activeprinter
v = Split(Application.ActivePrinter, Space(1))
sLocaleOn = Space(1) & CStr(v(UBound(v) - 1)) & Space(1)
' connect to WMI registry provider on current machine with current user
Set regobj = GetObject("WINMGMTS:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
' get the Devices from the registry
regobj.EnumValues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", aDevices, aTypes
' find Printer and create full name
For Each vDevice In aDevices
' get port of device
regobj.GetStringValue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", vDevice, sValue
' select device
If Left(vDevice, Len(Printer)) = Printer Then ' match!
' create localized printername
GetPrinterFullName = vDevice & sLocaleOn & Split(sValue, ",")(1)
Exit Function
End If
Next
' at this point no match found
GetPrinterFullName = vbNullString
End Function
Sub TestLayTenMayIn()
Sheet1.[A1] = GetPrinterFullName("Brother MFC-L2700DW")
End Sub
Sub TestIn2Mat()
Dim UsedRg As Range, Sh As Worksheet
Dim EndR As Long, Pg As Long
SetDuplex GetPrinterFullName("Brother MFC-L2700DW series"), 2
For Each Sh In ThisWorkbook.Worksheets
If Sh.Name <> "Khac" Then
EndR = Sh.Range("A" & Rows.Count).End(xlUp).Row
Sh.PageSetup.PrintArea = "$A$1:$F$" & EndR
Pg = ExecuteExcel4Macro("Get.Document(50)")
Sh.PrintOut From:=1, To:=Pg, Copies:=1
End If
Next
SetDuplex GetPrinterFullName("Brother MFC-L2700DW series"), 1
End Sub
Lần chỉnh sửa cuối:
