我曾经欺骗报告生成器为我制作 html 文档,但这种方法有局限性。首先,当您运行报告时,它会生成相当难看的 html,而不是可打印的报告。运行报表后还有更多工作可以将报表转换为漂亮的 html 文档,该文档可以在文字处理器中打开,然后保存为常规文档。 LibreOffice 通常比 ms-word 更适合接收生成的 html 文档,但偶尔 LibreOffice 无法完成这项工作(有一段时间它在链接图像方面存在问题)。文字处理器会忽略 css 样式,所以不要打扰样式,直接格式化仍然可以很好地工作,特别是对于文本是表格。如果所有导出的数据都在 html 表格中,那么使用 LibreOffice,因为 LibreOffice 可以根据 h1、h2、h3 标题生成目录,而 ms-word 不能。
这些天来,我只是将整个报告编写为 VBA 标准模块中的一个过程。我仍然不使用面向对象的代码,也没有理由在这里。完全用 VBA 编写的报告可以比标准 ms-Access 报告设计器生成的复杂得多。报告设计器报告需要大量修改才能使格式正确,这会耗费时间。对于复杂的报表,VBA 方法实际上更快。用 VBA 编写的报告可以每隔一秒运行一次,因此很容易调整表格的列宽等内容,并重新运行报告以检查输出。使用 VBA 创建的 html 报告被写为 html 文件,ms-access 可以发出 shell 命令以在 Web 浏览器中打开报告。如果浏览器已打开,则新报告会在新选项卡中打开,因此您可以看到以前版本的外观,因为此版本仍将在另一个选项卡中打开。
在标准模块(而不是表单模块)中编写报告,并从表单上的某些按钮单击事件中调用它。报告只需要被告知标题是什么,输出文件名和位置是什么以及报告应该输出的数据范围。报告过程包含创建报告所需的所有其他逻辑。以下是在我的一个应用程序中触发报告的调用过程。调用代码的目的是在分隔的文本文件中导出带有地理标记的照片列表,以便我可以在地图上绘制照片位置。导出 html 文件的过程非常相似。一些自定义函数在下面的代码中,但结构应该是可识别的。
Private Sub cmdCSV_File_Click()
Dim FolderName As String
Dim FileName As String
Dim ReportTitle As String
Dim SQL As String
Dim FixedFields As String
Dim WhereClause As String
Dim SortOrder As String
'Set destination of exported data
FolderName = InputBox("Please enter name of folder to export to", AppName, mDefaultFolder)
If mPaths.FolderExists(FolderName).Success Then
mDefaultFolder = FolderName 'holds default folder name in case it is needed again
Else
MsgBox "Can't find this folder", vbCritical, AppName
Exit Sub
End If
FileName = CheckTrailingSlash(FolderName) & "PhotoPoints.txt"
'Set Report Title
If Nz(Me.chkAllProjects, 0) Then
ReportTitle = "Photos from all Projects"
ElseIf Nz(Me.SampleID, 0) Then
ReportTitle = "Photos from Sample " & Me.SampleID
ElseIf Nz(Me.SurveyID, 0) Then
ReportTitle = "Photos from Survey " & Me.SurveyID
ElseIf Nz(Me.ProjectID, 0) Then
ReportTitle = "Photos from Project " & Me.ProjectID
Else
MsgBox "Please select a scope before pressing this button", vbExclamation, AppName
Exit Sub
End If
'Update paths to photos
If Have(Me.ProjectID) Then
WhereClause = " (PhotoPath_ProjectID = " & Me.ProjectID & ")" 'also covers sample and survey level selections
Else
WhereClause = " True" 'when all records is selected
End If
Call mPhotos.UpdatePhotoPaths(WhereClause) 'refreshes current paths
'Set fixed parts of SQL statement
FixedFields = "SELECT Photos.*, PhotoPaths.PhotoPath_Alias, PhotoPaths.CurrentPath & Photos.PhotoName AS URL, " _
& "PhotoPaths.CurrentPath & 'Thumbs\' & Photos.PhotoName as Thumb " _
& "FROM Photos INNER JOIN PhotoPaths ON Photos.PhotoPathID = PhotoPaths.PhotoPathID WHERE "
SortOrder = " ORDER BY ProjectID, SurveyID, SampleID, Photo_ID"
'set scope for export
WhereClause = "(((Photos.Latitude) Between -90 And 90) AND ((Photos.Longitude) Between -180 And 180) AND ((Photos.Latitude)<>0) AND ((Photos.Longitude)<>0)) AND " & WhereClause
SQL = FixedFields & WhereClause & SortOrder & ";"
'Export data as a delimited list
FileName = ExportCSV(FileName, SQL)
Call OpenBrowser(FileName)
End Sub
下一段代码实际上写出了分隔的文本文件(html 只有标签而不是管道)。在这种情况下,竖线或竖线用于分隔值而不是逗号,因为逗号可能出现在数据中。该代码计算出自己有多少列,并将标题放在顶部。
Public Function ExportCSV(FileAddress As Variant, SQL As String) As String
If Not gDeveloping Then On Error GoTo procerr
PushStack ("mfiles.ExportCSV")
'Exports a csv file
If Nz(FileAddress, "") = "" Then
ExportCSV = "Failed"
Exit Function
End If
'Create text file:
Dim webfile As Object, w
Set webfile = CreateObject("Scripting.FileSystemObject")
Set w = webfile.CreateTextFile(FileAddress, True)
Dim D As Database, R As Recordset, NumberOfFields As Long, Out As String, i As Long
Set D = CurrentDb()
Set R = D.OpenRecordset(SQL, dbOpenSnapshot)
If R.RecordCount > 0 Then
With R
NumberOfFields = .Fields.Count - 1
'Field headings
For i = 0 To NumberOfFields
If i = 0 Then
Out = .Fields(i).Name
Else
Out = Out & "|" & .Fields(i).Name
End If
Next
w.writeline Out
'Field data
Do Until .EOF
For i = 0 To NumberOfFields
If i = 0 Then
Out = .Fields(i)
Else
Out = Out & "|" & .Fields(i)
End If
Next i
w.writeline Out
.MoveNext
Loop
End With
End If
Set R = Nothing
Set D = Nothing
ExportCSV = FileAddress
exitproc:
PopStack
Exit Function
procerr:
Call NewErrorLog(Err.Number, Err.Description, gCurrentProc, FileAddress & ", " & SQL)
Resume exitproc
End Function
下面是来自 openbrowser 函数的 sn-p。该函数的其余部分用于确定网络浏览器的位置,因为这取决于 Windows 的版本以及浏览器是 32 位还是 64 位。
'Set up preferred browser
If Right(BrowserPath, 9) = "Opera.exe" Then
FilePrefix = "file://localhost/"
ElseIf Right(BrowserPath, 11) = "Firefox.exe" Then
FilePrefix = "file:///"
Else
FilePrefix = ""
End If
'Show report
Instruction = BrowserPath & " " & FilePrefix & WebpageName
TaskSuccessID = Shell(Instruction, vbMaximizedFocus)
此示例包含创建 html 报告所需的大约 90% 的代码,该报告的范围由调用它的表单设置。希望这能让某人克服困难。