我从未直接从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
答案 0 :(得分:0)
我的按钮OnClick属性以某种方式更改。我只需将其更改为事件过程。