|
Dim up, dn, le, ri, si, liAs Single , co As string'定义边距及页面函数
Sub ymszmk(strName As String) '页面设置模块
On Error GoTo Err_ymszmk
If Nz(DCount("*", "REPORTLIP", "REPORT='" & strName & "'")) = 0 Then
MsgBox "没有此报表的页面设置,请设置", , "提示"
Exit Sub
End If
up = DLookup("REUP", "REPORTLIP", "REPORT='" & strName & "'")
dn = DLookup("REDOWN", "REPORTLIP", "REPORT='" & strName & "'")
le = DLookup("RELEFT", "REPORTLIP", "REPORT='" & strName & "'")
ri = DLookup("RERIGHT", "REPORTLIP", "REPORT='" & strName & "'")
li = DLookup("RECOL", "REPORTLIP", "REPORT='" & strName & "'")
si = DLookup("RESIZE", "REPORTLIP", "REPORT='" & strName & "'")
co = IIf(DLookup("RECOURES", "REPORTLIP", "REPORT='" & strName & "'") Like "横向", acPRORLandscape, acPRORPortrait)Dim prt As Printer
Set prt = Application.Printers(0)
prt.TopMargin = up * 56.7 '上
prt.BottomMargin = dn * 56.7 '下
prt.LeftMargin = le * 56.7 '左
prt.RightMargin = ri * 56.7 '右
prt.ItemsAcross = li '列prt.PaperSize = si '大小
prt.Orientation = co
DoCmd.OpenReport strName, acPreview
Reports(strName).Printer = prt
Exit_Err_ymszmk: Exit Sub
Err_ymszmk: If Err = 5 Then
MsgBox "没有打印机,请先安装打印机!", , "提示"
Exit Sub
End If
MsgBox Err.Description
Resume Exit_Err_ymszmk
End Sub
请教,如上红色在执行中,提示拼写错或表没打开或没找到,
我想将如上设置过的是预览改为直接打印,应该怎么办
请大家帮个忙
新添加附件,请大家帮忙
大家帮个助,帮研究研究,此代码只有预览时生效,怎样才能直接打印呀,
[ 本帖最后由 whaojz 于 2009-1-12 17:11 编辑 ] |
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有帐号?注册
x
|