jeudi 16 juin 2016

Trying to export Data from an Access database to a chart in excel using VB. When I click the button to create the chart, nothing happens

I have never coded an application directly from Access, but it has been proving to be annoying. Every time I click on the button cmdChart nothing happens. I am not sure if there are any errors with the code. Access has no real syntax highlighting or error messages if something is wrong, so any input would be appreciated.

Here is the code I'm currently trying:

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

Aucun commentaire:

Enregistrer un commentaire