|
转帖网友的
报表打印如何用代码设定页面
Dim qdf As QueryDef
Dim ctlLabel As Control, ctlText As Control
Dim intDataX As Integer, intDataY As Integer
Dim intLabelX As Integer, intLabelY As Integer
Dim ncnt As Integer
Dim i As Integer
Dim ttlwidth As Double
Dim rptWaste As Report
Me.Painting = False
On Error Resume Next
Dim Dbs As Database, ctr As Container, doc As Document
Set Dbs = CurrentDb
ncnt = 0
Set rptWaste = CreateReport
Dbs.QueryDefs.Delete "www"
Set qdf = Dbs.CreateQueryDef("www", sql)
Dbs.QueryDefs.refresh
ttlwidth = 30
rptWaste.Section(acPageHeader).Height = 800
For i = 1 To 30 - 1
If Not (IsNull(adata(i)) Or Trim(adata(i)) = "") Then
Set ctlText = CreateReportControl(rptWaste.name, acTextBox, , "", "", intDataX, intDataY)
Set ctlLabel = CreateReportControl(rptWaste.name, acLabel, acPageHeader, , "NewLabel", intLabelX, intLabelY)
ctlLabel.Caption = adata(i)
ctlText.Width = 1000
If adata(i) = "card_no" Then
ctlText.Width = 1200
ctlLabel.Caption = "卡号"
End If
If adata(i) = "date" Then
ctlText.Width = 1300
ctlLabel.Caption = "日期"
End If
If adata(i) = "op_name" Then
ctlText.Width = 1300
ctlLabel.Caption = "工序号"
End If
If adata(i) = "class_name" Then
ctlText.Width = 1300
ctlLabel.Caption = "产品类型"
End If
If adata(i) = "dept_code" Then
ctlText.Width = 1000
ctlLabel.Caption = "车间代码"
End If
If adata(i) = "totalwaste_qty" Then
ctlText.Width = 1000
ctlLabel.Caption = "废品总重"
End If
' End If
ctlLabel.Width = ctlText.Width
ctlText.ControlSource = adata(i)
ctlText.BorderStyle = 1
ctlLabel.BorderStyle = 1
ctlText.Left = ttlwidth
ctlLabel.Left = ttlwidth
ctlLabel.Top = 800 - ctlLabel.Height
ctlLabel.FontBold = True
ttlwidth = ttlwidth + ctlText.Width
End If
Next i
rptWaste.RecordSource = "www"
rptWaste.Section(acDetail).Height = ctlText.Height
Set ctlLabel = CreateReportControl(rptWaste.name, acLabel, acPageHeader, , "NewLabel", intLabelX, intLabelY)
ctlLabel.Top = 0
ctlLabel.Caption = Trim(txtDepartment.value) & "废品统计报表"
ctlLabel.TextAlign = 2
ctlLabel.FontSize = 16
ctlLabel.FontBold = True
ctlLabel.Width = 4000
ctlLabel.Height = 500
ctlLabel.Left = (rptWaste.Width - ctlLabel.Width) / 2
Const DM_PORTRAIT = 1
Const DM_LANDSCAPE = 2
Dim DevString As str_DEVMODE
Dim DM As type_DEVMODE
Dim strDevModeExtra As String
If Not IsNull(rptWaste.PrtDevMode) Then
strDevModeExtra = rptWaste.PrtDevMode
DevString.RGB = strDevModeExtra
LSet DM = DevString
DM.lngFields = DM.lngFields Or DM.intOrientation ' Initialize fields.
'If DM.intOrientation = DM_PORTRAIT Then
DM.intOrientation = DM_LANDSCAPE
'Else
' DM.intOrientation = DM_PORTRAIT
'End If
LSet DevString = DM ' Update property.
Mid(strDevModeExtra, 1, 94) = DevString.RGB
rptWaste.PrtDevMode = strDevModeExtra
End If
DoCmd.DeleteObject acReport, "rptwaste_tmp"
DoCmd.Save , "rptwaste_tmp"
DoCmd.Close acReport, "rptwaste_tmp", acSaveNo
' For i = 0 To FORMs.Count - 1
' |
|