Access交流中心

北京 | 上海 | 天津 | 重庆 | 广州 | 深圳 | 珠海 | 汕头 | 佛山 | 中山 | 东莞 | 南京 | 苏州 | 无锡 | 常州 | 南通 | 扬州 | 徐州 | 杭州 | 温州 | 宁波 | 台州 | 福州 | 厦门 | 泉州 | 龙岩 | 合肥 | 芜湖 | 成都 | 遂宁 | 长沙 | 株洲 | 湘潭 | 武汉 | 南昌 | 济南 | 青岛 | 烟台 | 潍坊 | 淄博 | 济宁 | 太原 | 郑州 | 石家庄 | 保定 | 唐山 | 西安 | 大连 | 沈阳 | 长春 | 昆明 | 兰州 | 哈尔滨 | 佳木斯 | 南宁 | 桂林 | 海口 | 贵阳 | 西宁 | 乌鲁木齐 | 包头 |

vba设置自定义纸张

freeswan  发表于:2011-10-09 05:53:25  
复制

With Me.Printer
.TopMargin = 360
.BottomMargin = 360
.LeftMargin = 360
.RightMargin = 360
.PaperSize = acPRPSTabloid
End With

现在需要改为自定义纸张

tabloid +
11×18 英寸
自定义纸张已经设置好了

怎么加到代码里

另外还需要设置
列尺寸 主体相同

 

 

 

 

Top
dbaseIIIer 发表于:2011-10-09 07:26:02

设置系统没有的 纸张大小

 

Private Type str_DEVMODE
    RGB As String * 94
End Type

Private Type type_DEVMODE
    strDeviceName As String * 32
    intSpecVersion As Integer
    intDriverVersion As Integer
    intSize As Integer
    intDriverExtra As Integer
    lngFields As Long
    intOrientation As Integer
    intPaperSize As Integer
    intPaperLength As Integer
    intPaperWidth As Integer
    intScale As Integer
    intCopies As Integer
    intDefaultSource As Integer
    intPrintQuality As Integer
    intColor As Integer
    intDuplex As Integer
    intResolution As Integer
    intTTOption As Integer
    intCollate As Integer
    strFormName As String * 32
    lngPad As Long
    lngBits As Long
    lngPW As Long
    lngPH As Long
    lngDFI As Long
    lngDFr As Long
End Type

Public Sub CheckCustomPage(ByVal rptName As String)

    Dim DevString As str_DEVMODE
    Dim DM As type_DEVMODE
    Dim strDevModeExtra As String
    Dim rpt As Report
    Dim intResponse As Integer
   
    ' Opens report in Design view.
    DoCmd.OpenReport rptName, acDesign
    Set rpt = Reports(rptName)
   
    If Not IsNull(rpt.PrtDevMode) Then
        strDevModeExtra = rpt.PrtDevMode
       
        ' Gets current DEVMODE structure.
        DevString.RGB = strDevModeExtra
        LSet DM = DevString
        If DM.intPaperSize = 256 Then
       
            ' Display user-defined size.
            intResponse = MsgBox("The current custom page size is " & _
                          DM.intPaperWidth / 254 & " inches wide by " & _
                          DM.intPaperLength / 254 & " inches long. Do you want " & _
                          "to change the settings?", vbYesNo + vbQuestion)
        Else
            ' Currently not user-defined.
            intResponse = MsgBox("The report does not have a custom page size. " & _
                          "Do you want to define one?", vbYesNo + vbQuestion)
        End If
       
        If intResponse = vbYes Then
            ' User wants to change settings. Initialize fields.
            DM.lngFields = DM.lngFields Or DM.intPaperSize Or _
                           DM.intPaperLength Or DM.intPaperWidth
               
            ' Set custom page.
            DM.intPaperSize = 256
           
            ' Prompt for length and width.
            DM.intPaperLength = InputBox("Please enter page length in inches.") * 254
            DM.intPaperWidth = InputBox("Please enter page width in inches.") * 254
           
            ' Update property.
            LSet DevString = DM
            Mid(strDevModeExtra, 1, 94) = DevString.RGB
            rpt.PrtDevMode = strDevModeExtra
        End If
    End If
   
    Set rpt = Nothing
   
End Sub



dbaseIIIer 发表于:2011-10-09 07:27:34

VBA代码 设置 打印设置 内的所有东东

 

下面的 PrtMip 属性示例演示如何设置具有两个水平列的报表。

Private Type str_PRTMIP
    strRGB As String * 28
End Type

Private Type type_PRTMIP
    xLeftMargin As Long
    yTopMargin As Long
    xRightMargin As Long
    yBotMargin As Long
    fDataOnly As Long
    xWidth As Long
    yHeight As Long
    fDefaultSize As Long
    cxColumns As Long
    yColumnSpacing As Long
    xRowSpacing As Long
    rItemLayout As Long
    fFastPrint As Long
    fDatasheet As Long
End Type

Public Sub PrtMipCols(ByVal strName As String)

    Dim PrtMipString As str_PRTMIP
    Dim PM As type_PRTMIP
    Dim rpt As Report
    Const PM_HORIZONTALCOLS = 1953
    Const PM_VERTICALCOLS = 1954
    
    ' Open the report.
    DoCmd.OpenReport strName, acDesign
    Set rpt = Reports(strName)
    PrtMipString.strRGB = rpt.PrtMip
    LSet PM = PrtMipString
    
    ' Create two columns.
    PM.cxColumns = 2
    
    ' Set 0.25 inch between rows.
    PM.xRowSpacing = 0.25 * 1440
    
    ' Set 0.5 inch between columns.
    PM.yColumnSpacing = 0.5 * 1440
    PM.rItemLayout = PM_HORIZONTALCOLS
    
    ' Update property.
    LSet PrtMipString = PM
    rpt.PrtMip = PrtMipString.strRGB
    
    Set rpt = Nothing
    
End Sub
		

下一个 PrtMip 属性示例显示如何将全部页边距设为 1 英寸。

Public Sub SetMarginsToDefault(ByVal strName As String)

    Dim PrtMipString As str_PRTMIP
    Dim PM As type_PRTMIP
    Dim rpt As Report
    
    ' Open the report.
    DoCmd.OpenReport strName, acDesign
    Set rpt = Reports(strName)
    PrtMipString.strRGB = rpt.PrtMip
    LSet PM = PrtMipString
    
    ' Set margins.
    PM.xLeftMargin = 1 * 1440
    PM.yTopMargin = 1 * 1440
    PM.xRightMargin = 1 * 1440
    PM.yBotMargin = 1 * 1440
    
    ' Update property.
    LSet PrtMipString = PM
    rpt.PrtMip = PrtMipString.strRGB
    
    Set rpt = Nothing
    
End Sub
成员说明
LeftMargin、RightMargin、TopMargin、BottomMarginLong 值,用于指定页边缘和打印的项之间以为单位的距离。
DataOnly指定打印元素的 Long 值。为 True 时,只打印“数据表”视图、窗体或报表中的表数据或查询数据,不打印标签、控件的边框和网格线,而且显示诸如线条和方框等图形。为 False 时,打印数据、标签及图形。
ItemsAcrossLong 值,用于指定多列报表或标签中的列数。该成员与“页面设置”对话框“列”选项卡中“网格设置”下的“列数”框的值是相等的。
RowSpacingLong 值,以磅的 1/20 为单位,指定主体节间的水平间距。
ColumnSpacingLong 值,以缇为单位,指定主体节间的垂直间距。
DefaultSizeLong 值。为 True 时,使用“设计”视图中主体节的大小;为 False 时,使用 ItemSizeWidth 和 ItemSizeHeight 成员指定的值。
ItemSizeWidthLong 值,以缇为单位,指定主体节的宽度。该成员与“页面设置”对话框“列”选项卡中“列尺寸”下的“宽度”框的值相同。
ItemSizeHeightLong 值,以缇为单位,指定主体节的宽度。该成员与“页面设置”对话框“列”选项卡中“列尺寸”下的“高度”框的值相等。
ItemLayoutLong 值,用于指定水平 (1953) 或垂直 (1954) 的列布局。该成员与“页面设置”对话框“列”选项卡中“列布局”下的“先行后列”或“先列后行”选项分别相同。


freeswan 发表于:2011-10-10 03:32:54

With Me.Printer
.TopMargin = 360
.BottomMargin = 360
.LeftMargin = 360
.RightMargin = 360
.Orientation = acPRORLandscape
.DefaultSize = True
End With

只剩一个问题,怎么获得自定义纸张"tabloid +"的编号,以设置PaperSize



freeswan 发表于:2011-10-10 06:16:44
在不同的电脑上,自定义纸张的编号是不同的,在同一电脑上,删除并重新添加自定义纸张,编号也不相同。

dbaseIIIer 发表于:2011-10-10 07:39:37

你用上面的代码 Public Sub CheckCustomPage(ByVal rptName As String)

设好了长宽后, 还要选纸张大小吗?

 

应该就是 选"自定义大小" 啊!



freeswan 发表于:2011-10-10 07:54:43

DeviceCapabilities()

 

解决,谢谢!



总记录:6篇  页次:1/1 9 1 :