如何在VBA中用代码实现按照固定格式生成报告？

wing33709

附件中是一个ACCESS表格，模块1中的代码是让表格的列宽按照文本内容自适应。我现在想做的是在模块1中加一段代码，让May2011_Combinedtable生成报告，报告的列宽能够按照内容长度自适应，请教如何达到目的？我尝试过先生成报告，再调用自适应的那段代码，但是不成功。 请教各位高手。

All in one.zip (27.82 KB, 下载次数: 49)

2011-8-31 23:48 上传

点击文件名下载附件

roych

这不太可能吧？不过你可以试试在格式化里调用下。

wing33709

roych 发表于 2011-9-1 19:33
这不太可能吧？不过你可以试试在格式化里调用下。

我尝试过让VBA生成报告，成功了。但是在设定行宽的时候不成功了

roych

你那部分代码我看过了，只针对表或者查询有效。而在报表或者窗体里，只有设计模式下才能使用自适应方法。

wing33709

roych 发表于 2011-9-2 18:34
你那部分代码我看过了，只针对表或者查询有效。而在报表或者窗体里，只有设计模式下才能使用自适应方法。

那有没有办法在报表的设计模式下运行代码？

roych

这……你愿意让用户在设计模式下对报表瞎搞么？

wing33709

roych 发表于 2011-9-7 20:30
这……你愿意让用户在设计模式下对报表瞎搞么？

我在VBA中添加了下面这段代码，再加上附件里的列宽自适应代码，可以解决我的问题，但是还有一个问题，用这段代码后，报告的排版出了问题，有一些filed name 会重叠在一起，可以帮我看看吗？

Public Function StaticReportGen(SQLStr As String, Title As String, layout As String) As Boolean
    Dim strReportName As String
    Dim rpt As Report
    Dim FieldName As Field
    Dim RS As Recordset
    Dim intI As Integer
    Dim ctrl As Control
    Dim ColWidth As Integer
    Dim FirstCol As Boolean
    Dim TextWidth As Integer
    Dim TextCol As Boolean
    Dim TextBoxes As Collection
    Dim Labels As Collection
    Dim rsLengthCheck As ADODB.Recordset
    Dim objConn As ADODB.Connection
  
    On Error GoTo rptErrHandler
  
    ColWidth = 0
    TextWidth = 0
    TextCol = True
    FirstCol = True
  
    Set rpt = CreateReport()
    strReportName = rpt.Name
    rpt.Caption = Title
  
    DoCmd.RunCommand acCmdDesignView
    DoCmd.Save acReport, strReportName
    DoCmd.Close acReport, strReportName, acSaveNo
    DoCmd.Rename Title, acReport, strReportName
    DoCmd.OpenReport Title, acViewDesign
    Set rpt = Reports(Title)
  
    If layout = "Landscape" Then
        rpt.Printer.Orientation = acPRORLandscape
    Else
        rpt.Printer.Orientation = acPRORPortrait
    End If
  
    Set RS = CurrentDb.OpenRecordset(SQLStr)
    rpt.RecordSource = SQLStr
  
    'create label on pageheader
    For Each FieldName In RS.Fields
        CreateReportControl Title, acLabel, acPageHeader, , FieldName.Name, 0, 0
        CreateReportControl Title, acTextBox, acDetail, , FieldName.Name, 0, 0
        '
    Next FieldName
   
    'arrange fields
    For Each ctrl In rpt.Controls
  
        Select Case ctrl.ControlType
            Case acTextBox
                If TextCol Then
                    ctrl.Name = ctrl.ControlSource
                    ctrl.Move TextWidth, 0, ctrl.Width, ctrl.Height
                    TextWidth = TextWidth + ctrl.Width
                Else
                    ctrl.Name = ctrl.ControlSource
                    ctrl.Move TextWidth, 0, ctrl.Width, ctrl.Height
                    TextWidth = TextWidth + ctrl.Width
                End If
                TextCol = False
            Case acLabel
                If FirstCol Then
                    ctrl.Name = "lbl" & ctrl.Caption
                    ctrl.Move ColWidth, 0, ctrl.Width, ctrl.Height
                Else
                    ctrl.Name = "lbl" & ctrl.Caption
                    ctrl.Move TextWidth, 0, ctrl.Width, ctrl.Height
                End If
                ctrl.FontSize = 10
                ctrl.FontWeight = 700
                FirstCol = False
            Case Else
  
        End Select
  
    Next ctrl
    'create line
    CreateReportControl Title, acLine, acPageHeader, , , 0, 300, rpt.Width
  
    'create title
    CreateReportControl Title, acLabel, acHeader, , Title, 0, 0
    CreateReportControl Title, acTextBox, acHeader, , Chr(61) & Chr(34) & "Printed on:   " & Chr(34) & "& Date() ", 0, 300
  
    For Each ctrl In rpt.Controls
  
        Select Case ctrl.ControlType
            Case acTextBox
                If ctrl.Section = 1 Then
                    ctrl.FontWeight = 700
                    ctrl.FontSize = 14
                    ctrl.Height = 350
                    ctrl.Width = 3500
                    ctrl.Top = 400
                End If
  
            Case acLabel
                If ctrl.Section = 1 Then
                    ctrl.FontSize = 16
                    ctrl.FontWeight = 700
                    ctrl.Height = 350
                    ctrl.Width = 3500
                End If
        End Select
  
    Next ctrl
  
    'size fields correctly
    For Each ctrl In rpt.Controls
  
        Select Case ctrl.ControlType
  
            Case acTextBox
                For Each FieldName In RS.Fields
                    If ctrl.Name = FieldName Then
  
                    End If
                Next FieldName
  
            Case acLabel
  
        End Select
  
    Next ctrl
  
    DoCmd.Save acReport, Title
    DoCmd.OpenReport Title, acViewPreview
    StaticReportGen = True
    Exit Function
  
rptErrHandler:
    Select Case Err.Number
    End Select
    StaticReportGen = False
    Debug.Print Err.Number
    Debug.Print Err.Description
    Exit Function
End Function