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

Posted 2023-05-06

【中文标题】如何使用 vb.net 从查询创建访问报告

【英文标题】：How to create an Access report from a query using vb.net

【发布时间】：2015-03-27 13:18:14

【问题描述】：

让我解释一下尝试做什么。我有一个与访问数据库链接的 vb.net 表单。该表单允许您查询和搜索数据库。现在我想选择从同一查询中打印报告。

这就是我的表单的样子：

我想让用户选择他想在报告中看到的内容 根据查询创建报告 能够预览报告

打印出来

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

我能做什么：

我能够使用此link 打印已在 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

【问题讨论】：

您可以使用主互操作程序集来操作 excel 表并打印它吗？

可能，你能给我更多关于这方面的信息以及如何开始。

你能把你的代码贴在你从访问中获取数据的地方吗？有一个起点就好了。

@S.AdamNissley 我添加了一些代码，这会很快变得复杂，所以如果您需要更多代码或一些解释，请告诉我

您在问题中说您无法使用特定查询创建报告。你不是在这一行中使用查询：(da = New OleDb.OleDbDataAdapter(sql, con))？

【参考方案1】：

下面是一些示例代码，它使用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

【讨论】：

感谢您的帮助，它正在工作。我只需要更改您的代码以适合我的程序。