Question

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

这就是我的表格：

enter image description here

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

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

我能做什么：

我可以使用此link打印已在访问中创建的报告。
我能够在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

Answer 1

以下是使用OleDbConnection和Interop.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

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

1 个答案: