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, nCT as integer)
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
If QueryExists("qryOrgChartData") = True Then
Set qdf = curDB.QueryDefs("qryOrgChartData")
qdf.SQL = strsql
qdf.Close
End If
strsql = "Select Count(Mgr_Org) as ColCt from qryOrgChartData"
Set rs = curDB.OpenRecordset(strsql)
nct = rs.Fields("colct").value
rs.Close
PrtMipCols("rptOrgChart_template", nct)
DoCmd.OutputTo acOutputReport, "rptOrgChart_template", acFormatPDF, nrptName, True, , 0, acExportQualityScreen
K
If QueryExists("qryOrgChartData") = True Then
Set qdf = curDB.QueryDefs("qryOrgChartData")
qdf.SQL = strsql
qdf.Close
End If
rs.Close
strsql = "SELECT Count(A.MgrOrg) AS CountOfMgrOrg" & _
" FROM" & _
" (SELECT MgrOrg" & _
" FROM qryOrgChartData" & _
" GROUP BY MgrOrg) as A"
Set rs = curDB.OpenRecordset(strsql)
nCT = rs.Fields("CountOfMgrOrg").value
Debug.Print nCT
rs.Close
Dim stdocname As String
stdocname = "rptOrgChart_template"
PrtMipCols (stdocname, nct)
DoCmd.OutputTo acOutputReport, "rptOrgChart_template", acFormatPDF, nrptName, True, , 0, acExportQualityScreen
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 = nCT
If nCT < 11 Then
PM.xWidth = 1.75 * 1440
Else
PM.xWidth = 1.65 * 1440
End If
' 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
I am still attempting to get the necessary columns to print out on 1 page.
K