设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

页面设置模块代码分享

1970-1-1 08:00| 发布者: 佚名| 查看: 2932| 评论: 0

Dim up, dn, le, ri, si, liAs Single , co As string'定义边距及页面函数
Sub ymszmk(strName As String) '页面设置模块On Error GoTo Err_ymszmkIf Nz(DCount("*", "REPORTLIP", "REPORT='" & strName & "'")) = 0 ThenMsgBox "没有此报表的页面设置,请设置", , "提示"Exit SubEnd Ifup = 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, acPreviewReports(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_ymszmkEnd Sub

最新评论

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-4-27 06:33 , Processed in 0.060061 second(s), 16 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

返回顶部