VBA技巧:打印机控制秘籍,Application.ActivePrinter

为什么你的Excel报表总是打印到错误的打印机？

财务小张每月都要打印上百份报表，但每次都要手动选择打印机whatsapp webwhatsapp网页版，一不小心就打印到隔壁部门的打印机上，既浪费纸张又尴尬。今天我要分享的`Application.ActivePrinter`属性，就是解决这个问题的终极方案！

ActivePrinter是什么？

`Application.ActivePrinter`是Excel VBA中控制当前活动打印机的属性，通过它可以：

- 获取当前默认打印机信息

- 动态切换Excel使用的打印机

- 实现智能打印分配（如彩色/黑白自动选择）

实用场景，告别打印烦恼

1. 自动识别当前打印机（调试必备）

Sub 查看当前打印机()
MsgBox "当前打印机是：" & Application.ActivePrinter
End Sub

2. 智能切换打印机（再也不会打错了）

Sub 切换打印机()
' 查找网络中的打印机
Dim targetPrinter As String
targetPrinter = "\\PRINTSERVER\财务部彩色打印机 on Ne00:"
Application.ActivePrinter = targetPrinter
ActiveSheet.PrintOut ' 自动使用新设置的打印机
End Sub

3. 按条件选择打印机（专业版）

Sub 智能打印()
Dim currentSheet As Worksheet
Set currentSheet = ActiveSheet
' 根据内容选择打印机
If currentSheet.Range("A1").Value = "机密" Then
Application.ActivePrinter = "安全打印机 on Ne00:"
ElseIf currentSheet.Range("A1").Font.Color = RGB(255,0,0) Then
Application.ActivePrinter = "彩色打印机 on Ne01:"
Else
Application.ActivePrinter = "默认激光打印机 on Ne02:"
End If
currentSheet.PrintOut
End Sub

三、获取打印机全清单（高级技巧）

虽然VBA不能直接获取所有打印机列表，但可以通过API实现：

Option Explicit ' 强制显式声明所有变量，避免拼写错误
' API函数声明部分
' 获取ANSI字符串长度
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
' 枚举打印机函数声明
Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" _
(ByVal flags As Long, ByVal name As String, ByVal Level As Long, _
pPrinterEnum As Byte, ByVal cdBuf As Long, pcbNeeded As Long, _
pcReturned As Long) As Long
' 内存复制函数声明
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
' 打印机枚举类型常量定义
Private Const PRINTER_ENUM_LOCAL = &H2 ' 枚举本地打印机
Private Const PRINTER_ENUM_CONNECTIONS = &H4 ' 枚举网络连接的打印机
Private Const PRINTER_ENUM_NAME = &H8 ' 按名称枚举打印机
Private Const PRINTER_ENUM_SHARED = &H20 ' 枚举共享打印机
Private Const PRINTER_ENUM_NETWORK = &H40 ' 枚举网络打印机
Private Const PRINTER_ENUM_REMOTE = &H10 ' 枚举远程打印机
' 打印机信息结构体定义(Level 2)
Private Type PRINTER_INFO_2
pServerName As Long ' 服务器名称指针
pPrinterName As Long ' 打印机名称指针
pShareName As Long ' 共享名称指针
pPortName As Long ' 端口名称指针
pDriverName As Long ' 驱动程序名称指针
pComment As Long ' 注释信息指针
pLocation As Long ' 位置信息指针
pDevMode As Long ' DEVMODE结构指针
pSepFile As Long ' 分隔页文件指针
pPrintProcessor As Long ' 打印处理器指针
pDatatype As Long ' 数据类型指针
pParameters As Long ' 参数指针
pSecurityDescriptor As Long ' 安全描述符指针
Attributes As Long ' 打印机属性
Priority As Long ' 优先级
DefaultPriority As Long ' 默认优先级
StartTime As Long ' 开始时间
UntilTime As Long ' 结束时间
Status As Long ' 打印机状态
cJobs As Long ' 作业计数
AveragePPM As Long ' 平均每分钟页数
End Type
' 主过程：获取打印机列表
Sub GetPrinterList_API()
Dim pBuffer() As Byte ' 存储打印机信息的字节缓冲区
Dim pcbNeeded As Long ' 所需缓冲区大小
Dim pcReturned As Long ' 返回的打印机数量
Dim i As Long ' 循环计数器
Dim pi2 As PRINTER_INFO_2 ' 打印机信息结构体
Dim lRet As Long ' API函数返回值
Dim ws As Worksheet ' 工作表对象
Dim strPrinterName As String ' 打印机名称
Dim strPortName As String ' 端口名称
Dim strDriverName As String ' 驱动程序名称
Dim strDefault As String ' 是否默认打印机
' 创建新工作表存储结果
For Each ws In ThisWorkbook.Worksheets
If ws.name = "打印机清单" Then
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("打印机清单").Delete
Application.DisplayAlerts = True
Exit For
End If
Next ws
Set ws = ThisWorkbook.Sheets.Add
ws.name = "打印机清单"
' 设置表头
ws.Cells(1, 1).Value = "打印机名称"
ws.Cells(1, 2).Value = "端口"
ws.Cells(1, 3).Value = "驱动程序"
ws.Cells(1, 4).Value = "默认打印机"
' 第一次调用EnumPrinters：获取所需缓冲区大小
' 参数说明：
' flags - 枚举本地和网络连接的打印机
' name - 空字符串表示本地计算机
' Level - 2表示需要PRINTER_INFO_2结构
' pPrinterEnum - 第一次调用传0
' cdBuf - 缓冲区大小，第一次传0
' pcbNeeded - 返回所需的缓冲区大小
' pcReturned - 返回的打印机数量
lRet = EnumPrinters(PRINTER_ENUM_LOCAL Or PRINTER_ENUM_CONNECTIONS, vbNullString, 2, _
ByVal 0&, 0, pcbNeeded, pcReturned)
' 如果获取到所需缓冲区大小
If pcbNeeded > 0 Then
ReDim pBuffer(1 To pcbNeeded) ' 重新定义缓冲区大小
' 第二次调用EnumPrinters：获取实际打印机数据
lRet = EnumPrinters(PRINTER_ENUM_LOCAL Or PRINTER_ENUM_CONNECTIONS, vbNullString, 2, _
pBuffer(1), pcbNeeded, pcbNeeded, pcReturned)
' 如果调用成功
If lRet Then
' 遍历所有返回的打印机信息
For i = 0 To pcReturned - 1
' 将字节缓冲区中的数据复制到PRINTER_INFO_2结构体
' 计算每个打印机信息在缓冲区中的位置：1 + i * 结构体大小
CopyMemory pi2, pBuffer(1 + i * LenB(pi2)), LenB(pi2)
' 将指针转换为字符串
strPrinterName = PointerToString(pi2.pPrinterName) ' 获取打印机名称
strPortName = PointerToString(pi2.pPortName) ' 获取端口名称
strDriverName = PointerToString(pi2.pDriverName) ' 获取驱动程序名称
' 检查Attributes属性的第3位(0x4)判断是否为默认打印机
strDefault = IIf(pi2.Attributes And &H4, "是", "否")
' 将信息写入工作表
ws.Cells(i + 2, 1).Value = strPrinterName
ws.Cells(i + 2, 2).Value = strPortName
ws.Cells(i + 2, 3).Value = strDriverName
ws.Cells(i + 2, 4).Value = strDefault
Next i
End If
End If
' 自动调整列宽
ws.Columns("A:D").AutoFit
' 显示结果信息
MsgBox "已获取 " & pcReturned & " 台打印机信息", vbInformation
End Sub
' 辅助函数：将指针转换为字符串
Private Function PointerToString(ByVal lpszPointer As Long) As String
Dim lLen As Long ' 字符串长度
Dim abytString() As Byte ' 字节数组缓冲区
Dim lOffset As Long ' 偏移量(未使用)
' 检查指针是否有效
If lpszPointer Then
' 获取字符串长度(不包括null终止符)
lLen = lstrlen(lpszPointer)
If lLen Then
' 重新定义字节数组大小
ReDim abytString(0 To lLen - 1)
' 将指针指向的内存复制到字节数组
CopyMemory abytString(0), ByVal lpszPointer, lLen
' 将ANSI字节数组转换为Unicode字符串
PointerToString = StrConv(abytString, vbUnicode)
End If
End If
End Function

四、避坑指南（血泪经验）

1. 打印机名称格式必须完整

必须包含`on NeXX`端口信息（可通过先手动选择后查看ActivePrinter值获取）

2. 网络打印机要使用完整路径

`\\服务器名\打印机共享名 on Ne00:`

3. 更改只对当前Excel会话有效

不会影响系统默认打印机设置

4. 务必添加错误处理

On Error Resume Next
Application.ActivePrinter = "不存在的打印机"
If Err.Number <> 0 Then MsgBox "打印机设置失败！"

完整自动化案例：批量打印报表

Sub 批量打印月度报表()
Dim ws As Worksheet
Dim oldPrinter As String
' 保存原打印机设置
oldPrinter = Application.ActivePrinter
' 设置部门专用打印机
Application.ActivePrinter = "\\PRINTSERVER\财务部打印机 on Ne00:"
' 遍历所有工作表
For Each ws In ThisWorkbook.Worksheets
If ws.Name Like "*报表*" Then
ws.PrintOut Copies:=1, Collate:=True
DoEvents ' 防止卡死
End If
Next ws
' 恢复原打印机
Application.ActivePrinter = oldPrinter
MsgBox "所有报表已发送打印！", vbInformation
End Sub

六、延伸技巧：与打印设置搭配使用

Sub 专业打印设置()
With ActiveSheet.PageSetup
.Orientation = xlLandscape ' 横向打印
.Zoom = 80 ' 缩放80%
.PrintGridlines = True ' 打印网格线
End With
Application.ActivePrinter = "A3大幅面打印机 on Ne03:"
ActiveSheet.PrintOut
End Sub

掌握`Application.ActivePrinter`可以实现：

无人值守自动打印

按内容智能选择打印机

批量处理时自动切换设备

小贴士：建议先录制宏获取正确的打印机名称格式telegram中文版，再修改代码使用！