Private Sub mnuFilePrint_Click()
On Error Resume Next
If frmActivePrint Is Nothing Then Exit Sub
With dlgCommonDialog '打印机公用对话框
.DialogTitle = "打印"
.CancelError = True
.Flags = 1
Printer.FontSize = dlgCommonDialog.FontSize
'将打印机公用对话框设置的字体大小传递给打印机
.ShowPrinter ' 在屏幕上显示【打印】公用对话框
If Err <> MSComDlg.cdlCancel Then
Printer.FontTransparent = False '初始化打印的字体为不透明
SetPrinterScale frmActivePrint '匹配打印机的缩放属性与窗体的属性
For i = 1 To .Copies
Printer.NewPage '打印机坐标初始化
frmActivePrint.PrintForm
Printer.KillDoc
Next i
PrintAnywhere Printer '打印另一页的内容
Printer.NewPage '打印机坐标初始化
Printer.EndDoc '将该任务加入打印机任务队列
Printer.KillDoc '取消当前的打印任务
End If
End With
End Sub
Private Sub SetPrinterScale(obj As Object)
Dim pwid As Single, phgt As Single, xmid As Single, ymid As Single
Dim owid As Single, ohgt As Single
owid = obj.ScaleX(obj.ScaleWidth, obj.ScaleMode, vbTwips)
ohgt = obj.ScaleY(obj.ScaleHeight, obj.ScaleMode, vbTwips)
'获取窗体以Twips表示的尺寸
pwid = Printer.ScaleX(Printer.ScaleWidth, Printer.ScaleMode, vbTwips)
phgt = Printer.ScaleY(Printer.ScaleHeight, Printer.ScaleMode, vbTwips)
'获取打印机以Twips表示的尺寸
If (ohgt / owid > phgt / pwid) Then
s = phgt / ohgt
Else
s = pwid / owid
End If '计算缩放因子
pwid = obj.ScaleX(pwid, vbTwips, obj.ScaleMode) / s
phgt = obj.ScaleY(phgt, vbTwips, obj.ScaleMode) / s
'将打印机的尺寸转换成obj的坐标系统 / 缩放因子
x_mid = obj.ScaleLeft + obj.ScaleWidth / 2
y_mid = obj.ScaleTop + obj.ScaleHeight / 2 '设置打印区域的中心点坐标
Printer.Scale (x_mid - pwid / 2, y_mid - phgt / 2)-(x_mid + pwid / 2, y_mid + phgt / 2)
' 设置打印机中新的ScaleWidth和ScaleHeight
End Sub