如何使用vb.net从查询创建Access报告

让我解释一下你想做什么。我有一个与access数据库链接的vb.net表单。该表单允许您进行查询并搜索数据库。现在，我想设置打印来自同一查询的报告的选项

这就是我的表格的样子：

我想让用户选择他想在报告中看到的内容

根据查询创建报告

能够预览报告

打印出来

我在任何地方都找不到如何使用特定查询创建报告

我能做的：

我能够打印一份已经在access中使用此工具创建的报告

我能够打印并在excel表格中显示查询结果

---

这是我连接到数据库并在excel中显示结果的代码部分

    ' Connect to the database and send the query
    Dim con As New OleDb.OleDbConnection
    Dim ds As New DataSet
    Dim da As OleDb.OleDbDataAdapter
    Dim MaxRows As Integer

    Try
        con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=|DataDirectory|\docs-management.mdb"
        con.Open()

        da = New OleDb.OleDbDataAdapter(sql, con)

        da.Fill(ds, "DocList")

        ' Discover if there's a successful search
        MaxRows = ds.Tables("DocList").Rows.Count

        If MaxRows = 0 Then
            MsgBox("No documents were found using this filter.")
            con.Close()
            Exit Sub
        End If

        Dim YesOrNoAnswerToMessageBox As String
        Dim QuestionToMessageBox As String

        QuestionToMessageBox = MaxRows & " Document(s) have been found and will be put into an excel spreadsheet." & _
        vbCrLf & "Would you like to continue?"

        YesOrNoAnswerToMessageBox = MsgBox(QuestionToMessageBox, vbYesNo, "Narrowing your search")

        If YesOrNoAnswerToMessageBox = vbNo Then
            Exit Sub
        Else
        End If

        Dim oExcel As Object
        Dim oBook As Object
        Dim oSheet As Object
        oExcel = CreateObject("Excel.Application")
        oExcel.Visible = True
        oBook = oExcel.Workbooks.Add
        oSheet = oBook.Worksheets(1)



        'Transfer the data to Excel
        For columns = 0 To ds.Tables("DocList").Columns.Count - 1
            oSheet.Cells(1, columns + 1) = ds.Tables("DocList").Columns(columns).ColumnName
        Next
        oSheet.Rows("1:1").Font.Bold = True
        For col = 0 To ds.Tables("DocList").Columns.Count - 1
            For row = 0 To ds.Tables("DocList").Rows.Count - 1
                oSheet.Cells(row + 2, col + 1) = ds.Tables("DocList").Rows(row).ItemArray(col)
                ' This is where we make hyperlinks out of the file locations
                If ds.Tables("DocList").Columns(col).ToString = "File_Location" Then
                    oSheet.Hyperlinks.Add(Anchor:=oSheet.Cells(row + 2, col + 1), Address:=ds.Tables("DocList").Rows(row).ItemArray(col), TextToDisplay:=ds.Tables("DocList").Rows(row).ItemArray(col))
                End If
            Next
        Next

        con.Close()

    Catch
        MsgBox("An error has been generated while contacting or transfering data from the database.")
    End Try

---

下面是一个使用

OleDbConnection

和

Interop.Excel

生成工资单报告的示例代码。我认为这与此相关，因为返回的行可能有也可能没有所有列的值。报表是在Excel中动态生成的，忽略了没有值的列

Private Sub PayGrid_Report()
    'PayGrid Report

    If MessageBox.Show("Did you select a payperiod?",
                       "Just checking...",
                       MessageBoxButtons.YesNo,
                       MessageBoxIcon.Question) = Windows.Forms.DialogResult.No Then Exit Sub

    Dim wb As Microsoft.Office.Interop.Excel.Workbook
    Dim ws As Microsoft.Office.Interop.Excel.Worksheet
    Dim xl As New Microsoft.Office.Interop.Excel.Application

    'Create a save file dialog
    Dim SaveFileDialog1 As SaveFileDialog
    With SaveFileDialog1
        .Filter = "Excel Workbooks|*.xlsx"
        .AddExtension = True
        .RestoreDirectory = True
        .Title = "Save Report"
        .OverwritePrompt = True
    End With

    'Ask the user where to save the file.
    If SaveFileDialog1.ShowDialog() <> System.Windows.Forms.DialogResult.OK Then Exit Sub
    Cursor = Cursors.WaitCursor 'spin the cursor so the user doesn't think it "froze"

    'Set up the connection to the database
    Dim dbConn As New System.Data.OleDb.OleDbConnection("Valid Connection String Here")
    dbConn.Open()
    Dim dbComm As New System.Data.OleDb.OleDbCommand
    With dbComm
        .Connection = dbConn
        .CommandType = CommandType.StoredProcedure
        .CommandText = "PayrollFunctions"
        .Parameters.Add("PayPeriod", OleDbType.VarChar).Value = "2015P06" 'usually get a value from the form
        .Parameters.Add("OutputType", OleDbType.Integer).Value = 4 'usually get a value from the form
    End With

    'start a data reader
    Dim r As System.Data.OleDb.OleDbDataReader = dbComm.ExecuteReader(CommandBehavior.CloseConnection)

    Dim rownum As Int32 = 0 'the row to write to in Excel
    Dim t As Int32 'Top of each "report item" - used for formatting
    Dim b As Int32 'Bottom of each "report item" - used for formatting

    xl.Visible = True 'show Excel so the user can see the report building
    wb = xl.Workbooks.Add() 'add a workbook to Excel
    ws = wb.Sheets.Add 'add a sheet to the workbook
    ws.Name = "PayGrid_Report" 'name the sheet

    While r.Read()
        rownum += 2
        t = rownum
        ws.Cells(rownum, 2) = r("EmployeeID")
        ws.Cells(rownum, 3) = r("EmployeeName")
        ws.Cells(rownum, 4) = r("PayrollDepartment")
        ws.Range(ws.Cells(rownum, 2), ws.Cells(rownum, 4)).Font.Bold = True

        If r("RegularHours") > 0 Then
            rownum += 1
            b = rownum
            ws.Cells(rownum, 5) = "Regular Hours:"
            ws.Cells(rownum, 6) = r("RegularHours")
            ws.Cells(rownum, 7) = "@"
            ws.Cells(rownum, 8) = r("RateReg")
            ws.Cells(rownum, 9) = "="
            ws.Cells(rownum, 10) = r("RegDollars")
        End If

        If r("OTHours") > 0 Then
            rownum += 1
            b = rownum
            ws.Cells(rownum, 5) = "Overtime Hours:"
            ws.Cells(rownum, 6) = r("OTHours")
            ws.Cells(rownum, 7) = "@"
            ws.Cells(rownum, 8) = r("RateOT")
            ws.Cells(rownum, 9) = "="
            ws.Cells(rownum, 10) = r("OTDollars")
        End If

        If r("LeaveHours") > 0 Then
            rownum += 1
            b = rownum
            ws.Cells(rownum, 5) = "Vacation Hours:"
            ws.Cells(rownum, 6) = r("LeaveHours")
            ws.Cells(rownum, 7) = "@"
            ws.Cells(rownum, 8) = r("RateVac")
            ws.Cells(rownum, 9) = "="
            ws.Cells(rownum, 10) = r("LeaveDollars")
        End If

        If r("HolidayHours") > 0 Then
            rownum += 1
            b = rownum
            ws.Cells(rownum, 5) = "Holiday Hours:"
            ws.Cells(rownum, 6) = r("HolidayHours")
            ws.Cells(rownum, 7) = "@"
            ws.Cells(rownum, 8) = r("RateHol")
            ws.Cells(rownum, 9) = "="
            ws.Cells(rownum, 10) = r("HolidayDollars")
        End If

        If r("OtherHours") > 0 Then
            If r("RateOtherBas") > 0 Then
                rownum += 1
                b = rownum
                ws.Cells(rownum, 5) = "Other Hours:"
                ws.Cells(rownum, 6) = r("OtherHours")
                ws.Cells(rownum, 7) = "@"
                ws.Cells(rownum, 8) = r("RateOtherBas")
                ws.Cells(rownum, 9) = "="
                ws.Cells(rownum, 10) = r("OtherBaseDollars")
            End If

            If r("RateOtherHol") > 0 Then
                rownum += 1
                b = rownum
                ws.Cells(rownum, 5) = "Other Holiday:"
                ws.Cells(rownum, 6) = r("OtherHours")
                ws.Cells(rownum, 7) = "@"
                ws.Cells(rownum, 8) = r("RateOtherHol")
                ws.Cells(rownum, 9) = "="
                ws.Cells(rownum, 10) = r("OtherHolDollars")
            End If

            If r("RateOtherVac") > 0 Then
                rownum += 1
                b = rownum
                ws.Cells(rownum, 5) = "Other Vacation:"
                ws.Cells(rownum, 6) = r("OtherHours")
                ws.Cells(rownum, 7) = "@"
                ws.Cells(rownum, 8) = r("RateOtherVac")
                ws.Cells(rownum, 9) = "="
                ws.Cells(rownum, 10) = r("OtherVacDollars")
            End If

            If r("RateOtherBen") > 0 Then
                rownum += 1
                b = rownum
                ws.Cells(rownum, 5) = "Other Benefits:"
                ws.Cells(rownum, 6) = r("OtherHours")
                ws.Cells(rownum, 7) = "@"
                ws.Cells(rownum, 8) = r("RateOtherBen")
                ws.Cells(rownum, 9) = "="
                ws.Cells(rownum, 10) = r("OtherBenDollars")
            End If
        End If 'If r("OtherHours") > 0

        rownum += 1
        b = rownum
        ws.Cells(rownum, 5) = "Total:"
        ws.Cells(rownum, 6) = r("TotalHours")
        ws.Cells(rownum, 10) = r("TotalDollars")
        ws.Range(ws.Cells(rownum, 5), ws.Cells(rownum, 10)).Font.Bold = True

        'create border around report item
        Dim LS As Microsoft.Office.Interop.Excel.XlLineStyle = Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous
        Dim BW As Microsoft.Office.Interop.Excel.XlBorderWeight = Microsoft.Office.Interop.Excel.XlBorderWeight.xlThin
        With ws.Range(ws.Cells(t, 2), ws.Cells(b, 10))
            .Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeTop).LineStyle = LS
            .Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeTop).Weight = BW
            .Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeBottom).LineStyle = LS
            .Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeBottom).Weight = BW
            .Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeLeft).LineStyle = LS
            .Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeLeft).Weight = BW
            .Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeRight).LineStyle = LS
            .Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeRight).Weight = BW
        End With

    End While
    r.Close()

    ws.Columns.AutoFit()
    ws.Range(ws.Cells(1, 1), ws.Cells(1, 1)).ColumnWidth = 0.42

    'Format the page setup
    ws.PageSetup.Orientation = Microsoft.Office.Interop.Excel.XlPageOrientation.xlPortrait
    ws.PageSetup.FitToPagesWide = 1
    ws.PageSetup.FitToPagesTall = 99
    ws.PageSetup.LeftHeader = "Paygrid Report"
    ws.PageSetup.CenterHeader = "Pay Period 06"
    ws.PageSetup.RightHeader = "Page &P of &N"
    ws.PageSetup.LeftFooter = "Generated " & Today.ToShortDateString

    wb.SaveAs(SaveFileDialog1.FileName)
    wb.Close()
    xl.Quit()

    Dim psi As New System.Diagnostics.ProcessStartInfo
    psi.FileName = "excel"
    psi.Arguments = """" & SaveFileDialog1.FileName & """"
    Dim proc As System.Diagnostics.Process = System.Diagnostics.Process.Start(psi)

    Cursor = Cursors.Default
End Sub

Private Sub-PayGrid_报告（）
“支付网格报告”
如果MessageBox.Show（“您是否选择了付款期？”，
“只是检查一下……”，
MessageBoxButtons.YesNo，
MessageBoxIcon.Question）=Windows.Forms.DialogResult.No然后退出Sub
将wb设置为Microsoft.Office.Interop.Excel.Workbook
将ws设置为Microsoft.Office.Interop.Excel.Worksheet
Dim xl作为新的Microsoft.Office.Interop.Excel.Application
'创建保存文件对话框
将SaveFileDialog1设置为SaveFileDialog
使用SaveFileDialog1
.Filter=“Excel工作簿|*.xlsx”
.AddExtension=True
.RestoreDirectory=True
.Title=“保存报告”
.OverwritePrompt=True
以
'询问用户保存文件的位置。
如果选择SaveFileDialog1.ShowDialog（）System.Windows.Forms.DialogResult.OK，则退出Sub
Cursor=Cursors.WaitCursor'旋转光标，以便用户不会认为它“冻结”
'设置与数据库的连接
Dim dbConn作为新System.Data.OleDb.OleDbConnection（“此处的有效连接字符串”）
dbConn.Open（）
Dim dbComm作为新System.Data.OleDb.OleDbCommand
使用dbComm
.Connection=dbConn
.CommandType=CommandType.StoredProcess
.CommandText=“PayrollFunctions”
.Parameters.Add（“PayPeriod”，OleDbType.VarChar）。Value=“2015P06”通常从表单中获取值
.Parameters.Add（“OutputType”，OleDbType.Integer）。Value=4'通常从表单中获取值
以
'启动数据读取器
Dim r As System.Data.OleDb.OleDbDataReader=dbComm.ExecuteReader（CommandBehavior.CloseConnection）
Dim rownum As Int32=0'Excel中要写入的行
将t调为每个“报告项”的Int32'顶部-用于格式化
尺寸b为每个“报告项”的Int32'底部-用于格式化
xl.Visible=True“显示Excel以便用户可以查看报表生成
wb=xl.Workbooks.Add（）'将工作簿添加到Excel
ws=wb.Sheets.Add“将工作表添加到工作簿”
ws.Name=“PayGrid\u Report””为工作表命名
而r.Read（）
rownum+=2
t=行数
ws.Cells（rownum，2）=r（“员工ID”）
ws.Cells（rownum，3）=r（“员工名称”）
ws.Cells（rownum，4）=r（“工资部门”）
ws.Range（ws.Cells（rownum，2），ws.Cells（rownum，4））.Font.Bold=True
如果r（“正常小时数”）>0，则
rownum+=1
b=行数
ws.Cells（rownum，5）=“正常工作时间：”
ws.Cells（rownum，6）=r（“正常小时”）
ws.Cells（rownum，7）=“@”
ws.Cells（rownum，8）=r（“RateReg”）
ws.Cells（rownum，9）=”
ws.Cells（rownum，10）=r（“RegDollars”）
如果结束
如果r（“其他”）>0，则
rownum+=1
b=行数
ws.Cells（rownum，5）=“加班时间：”
ws.Cells（rownum，6）=r（“其他小时”）
ws.Cells（rownum，7）=“@”
ws.Cells（rownum，8）=r（“RateOT”）
ws.Cells（rownum，9）=”
ws.Cells（rownum，10）=r（“OTU”）
如果结束
如果r（“LeaveHours”）>0，则
rownum+=1
b=行数
ws.Cells（rownum，5）=“休假时间：”
ws.Cells（rownum，6）=r（“LeaveHours”）
ws.Cells（rownum，7）=“@”
ws.Cells（rownum，8）=r（“RateVac”）
ws.Cells（rownum，9）=”
ws.Cells（rownum，10）=r（“离开美元”）
如果结束
如果r（“假期时间”）大于0，则
rownum+=1
b=行数
ws.Cells（rownum，5）=“假日时间：”
ws.Cells（rownum，6）=r（“假期小时”）
ws.Cells（rownum，7）=“@”
ws.Cells（rownum，8）=r（“RateHol”）
ws.Cells（rownum，9）=”
ws.Cells（rownum，10）=r（“假日美元”）
如果结束
如果r（“其他小时”）>0，则
如果r（“RateOtherBas”）>0，则
rownum+=1
b=行数
ws.Cells（rownum，5）=“其他小时：”
ws.Cells（rownum，6）=r（“其他小时”）
ws.Cells（rownum，7）=“@”
ws.Cells（rownum，8）=r（“RateOtherBas”）
ws.Cells（rownum，9）=”
ws.Cells（rownum，10）=r（“其他基本美元”）
如果结束
如果r（“RateOtherHol”）>0，则
rownum+=1
b=行数
ws.Cells（rownum，5）=“其他假日：”
ws.Cells（rownum，6）=r（“其他小时”）
ws.Cells（rownum，7）=“@”
ws.Cells（rownum，8）=r（“RateOtherHol”）
ws.Cells（rownum，9）=”
ws.Cells（rownum，10）=r（“其他holdollars”）
如果结束
如果r（“RateOtherVac”）>0，则