尝试使用VB将数据从Access数据库导出到excel中的图表。当我单击按钮创建图表时,没有任何反应

时间:2016-06-14 17:50:34

标签: vb.net excel access

我从未直接从Access编写应用程序,但事实证明它很烦人。每次我点击cmdChart按钮都没有任何反应。我不确定代码是否有任何错误。如果出现问题,Access没有真正的语法突出显示或错误消息,因此任何输入都将受到赞赏。

以下是我正在尝试的代码:

Private Sub cmdChart_Click()
On Error GoTo SubError

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim SQL As String
Dim rs1 As DAO.Recordset
Dim i As Integer
Dim qtr As String
Dim yr As String
Dim xlChart As Excel.ChartObject
Dim rng As Range

'Show user work is being performed
DoCmd.Hourglass (True)

'*********************************************
'              RETRIEVE DATA
'*********************************************
'SQL statement to retrieve data from database
SQL = "SELECT 'Completed' AS Status, Count(tblPMWOs.PMWOID) AS CountOfPMWOID " & _
        "From tblPMWOs " & _
        "WHERE (([tblPMWOs].[DateComplete] >= DateAdd('m',-10,DateValue(#[@DailyReportStartDate]#))) AND ([tblPMWOs].[DateComplete] < DateAdd('d',1,DateValue(#[@DailyReportEndDate]#)))) " & _
        "UNION ALL " & _
        "SELECT 'Open' AS Status, Count(tblPMWOs.PMWOID) AS CountOfPMWOID " & _
        "From tblPMWOs " & _
        "WHERE (((tblPMWOs.DateGenerated) < #[@DailyReportEndDate]#) And ((tblPMWOs.DateComplete) >= #[@DailyReportEndDate]# Or (tblPMWOs.DateComplete) Is Null)) " & _
        "Group BY 'Open' "

'Execute query and populate recordset
Set rs1 = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)

'If no data, don't bother opening Excel, just quit
If rs1.RecordCount = 0 Then
    MsgBox "No data selected for export", vbInformation + vbOKOnly, "No data exported"
    GoTo SubExit
End If

'*********************************************
'             BUILD SPREADSHEET
'*********************************************
'Create an instance of Excel and start building a spreadsheet
'Early Binding
Set xlApp = Excel.Application

xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)

With xlSheet

    .Cells.Font.Name = "Calibri"
    .Cells.Font.Size = 11

    'Set column widths
    .Columns("B").ColumnWidth = 10
    .Columns("C").ColumnWidth = 11
    .Columns("D").ColumnWidth = 15
    .Columns("E").ColumnWidth = 15
    .Columns("F").ColumnWidth = 10

    'Format columns
    .Columns("D").NumberFormat = "$#,##0.00;-$#,##0.00"
    .Columns("E").NumberFormat = "$#,##0.00;-$#,##0.00"


    'Build values for second graph title - pull quarter and year off of first row
    'Won't work if you are pulling multiple time periods!
    Select Case Nz(rs1!SalesQuarter, "")
        Case 1
            qtr = "1st"
        Case 2
            qtr = "2nd"
        Case 3
            qtr = "3rd"
        Case 4
            qtr = "4th"
        Case Else
            qtr = "???"
    End Select
    yr = Nz(rs1!SalesYear, Year(Date))

    'Column headings for the data grid
    .Range("C22").Value = "Division"
    .Range("D22").Value = "Gross Sales"
    .Range("E22").Value = "Gross Margin"

    .Range("C22:E22").HorizontalAlignment = xlCenter
    .Range("C22:E22").Cells.Font.Bold = True
    .Range("C22:E22").Cells.Font.Color = RGB(15, 36, 62)
    .Range("C22:E22").Interior.Color = RGB(141, 180, 226)


    'provide initial value to row counter
    i = 23
    'Loop through recordset and copy data from recordset to sheet
    Do While Not rs1.EOF

        .Range("C" & i).Value = Nz(rs1!Division, "")
        .Range("D" & i).Value = Nz(rs1!GrossSales, 0)
        .Range("E" & i).Value = Nz(rs1!GrossMargin, 0)

        i = i + 1
        rs1.MoveNext

    Loop

   .Range("C23:E" & i - 1).Interior.Color = RGB(220, 230, 241)
   .Range("C23:E" & i - 1).Cells.Font.Color = RGB(22, 54, 92)


    'grid-lines for data grid
    .Range("C22:E22").Borders(xlEdgeTop).LineStyle = XlLineStyle.xlContinuous
    .Range("C22:E22").Borders(xlEdgeTop).Color = RGB(22, 54, 92)
    .Range("C22:C" & i - 1).Borders(xlEdgeLeft).LineStyle = XlLineStyle.xlContinuous
    .Range("C22:C" & i - 1).Borders(xlEdgeLeft).Color = RGB(22, 54, 92)
    .Range("E22:E" & i - 1).Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
    .Range("E22:E" & i - 1).Borders(xlEdgeRight).Color = RGB(22, 54, 92)
    .Range("C22:E" & i - 1).Borders(xlInsideVertical).LineStyle = XlLineStyle.xlContinuous
    .Range("C22:E" & i - 1).Borders(xlInsideVertical).Color = RGB(22, 54, 92)
    .Range("C22:E" & i - 1).Borders(xlInsideHorizontal).LineStyle = XlLineStyle.xlContinuous
    .Range("C22:E" & i - 1).Borders(xlInsideHorizontal).Color = RGB(22, 54, 92)
    .Range("C" & i - 1 & ":E" & i - 1).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
    .Range("C" & i - 1 & ":E" & i - 1).Borders(xlEdgeBottom).Color = RGB(22, 54, 92)


    'Create the chart
        '(left, top, width, height) / 72 points per inch
    Set xlChart = .ChartObjects.Add(50, 20, 338, 273)

    With xlChart
        .RoundedCorners = True
        With .Chart
            .chartType = xlColumnClustered

            .HasTitle = True
            With .ChartTitle
                .Text = "Gross Sales and Gross Margin" & _
                      vbCr & qtr & " Quarter " & yr

                With .Font
                    .Name = "Calibri"
                    .FontStyle = "Bold"
                    .Size = 14
                End With    'end Font
            End With    'end .ChartTitle

            .HasLegend = True
            .Legend.Position = xlLegendPositionBottom


            'Method 1:  Easy
            '.SetSourceData Source:=xlSheet.Range("C22:E" & i - 1)

            'Method 2:  more control
            .SeriesCollection.NewSeries
            .SeriesCollection(1).Name = xlSheet.Range("D22")
            .SeriesCollection(1).Values = xlSheet.Range("D23:D" & i - 1)
            .SeriesCollection(1).XValues = xlSheet.Range("C23:C" & i - 1)

            .SeriesCollection.NewSeries
            .SeriesCollection(2).Name = xlSheet.Range("E22")
            .SeriesCollection(2).Values = xlSheet.Range("E23:E" & i - 1)
            .SeriesCollection(2).XValues = xlSheet.Range("C23:C" & i - 1)

            .Axes(xlCategory).HasTitle = True
            .Axes(xlCategory).AxisTitle.Caption = "Divisions"
                '(xlCategory = x-axis, xlValue = y-axis)

        End With    'end .Chart
    End With    'end xlChart
End With

 SubExit:
 On Error Resume Next

DoCmd.Hourglass False
xlApp.Visible = True
rs1.Close
Set rs1 = Nothing

Exit Sub

SubError:
    MsgBox "Error Number: " & Err.Number & "= " & Err.Description,      vbCritical + vbOKOnly, _
        "An error occurred"
    GoTo SubExit

End Sub

1 个答案:

答案 0 :(得分:0)

我的按钮OnClick属性以某种方式更改。我只需将其更改为事件过程。