我正在从 中Powerpoint 2007
的查询更新图表Access 2007
。图表是使用Insert ~ Object ~ Microsoft Office Excel Chart
手动添加和设置的,应该看起来像这样(我已经混淆了轴标签):
问题
我的 Access 查询返回所选月份的数据,但是我需要为月份之间的空格添加两个额外的系列。
目前我将数据放在工作表中,插入空白行并使用公式计算该月的最大值,加 2 并减去该月的原始数据值。
公式的一个例子是: =MAX(R3C2:R3C17)+2-R3C
。
如果我逐步执行我的代码,则此公式输入正确,但如果我运行代码,它显示为=MAX(R3C2:R3C17)+2-R3C[-1]
(在工作表中转换为 A1 样式)并且我的图表显示为:
我确实尝试更新代码,所以最终结果C
是C[+1]
并且这有效有一段时间(但我对此不满意,因为它不应该工作,我不知道为什么会这样)。
添加公式的代码行是:
.Range(.cells(x, 2), .cells(x, oLastCell.Column)).FormulaR1C1 = _
"=MAX(R" & x - 1 & "C2:R" & x - 1 & "C" & oLastCell.Column & ")+2-R" & x - 1 & "C"
如您所见,即使公式位于第 3 行,我也使用x-1
而不是R[-1]
在公式中返回第 65536 行。R[-1]
图表后面的数据如下所示(您可以看到公式在尝试引用列 A 时返回错误值的位置)。
我正在寻找的解决方案:
如何正确地将公式输入到工作表
中(不敢相信我在从 Excel 97 开始后会问这个问题)。
或将交叉表查询与计算数据结合起来执行与公式相同的功能。
(我将添加 SQL 并解释是否有人认为这是一个更好的选择)。
生成报告的代码如下(代码在 Access 中)。
代码入口点:
Option Compare Database
Option Explicit
Private sReportMonth As String 'Text displaying current month.
Private sReportYear As String 'Text displaying current year.
Public Sub Produce_Report()
Dim sTemplate As String 'Path to PPTX Template.
Dim oPPT As Object 'Reference to PPT application.
Dim oPresentation As Object 'Reference to opened presentation.
Dim oSlide As Object 'Reference to slide in PPT.
sTemplate = CurrentProject.Path & "\PPT Template\Reported Errors Template.pptx"
Set oPPT = CreatePPT
Set oPresentation = oPPT.Presentations.Open(sTemplate)
sReportMonth = Forms!frm_CreateReport!lstMonths.Column(1)
sReportYear = Forms!frm_CreateReport!txtYear
'Add the month and year to the Title slide.
Set oSlide = oPresentation.slides(1)
With oSlide
.Shapes("Report_Date").TextFrame.TextRange.Text = sReportMonth & " " & sReportYear
End With
Set oSlide = Nothing
Error_Trends oPresentation.slides(2)
Error_Origin oPresentation.slides(4)
'''''''''''''''''''''''''''''''''''''''''''''''''
'These two procedures produce the chart errors. '
'''''''''''''''''''''''''''''''''''''''''''''''''
Error_Categories oPresentation.slides(5)
TeamBreakdown oPresentation.slides(6)
MsgBox "Complete"
End Sub
TeamBreakdown 代码:
(Error_Categories 是相同的 - 一旦我知道发生了什么,我将合并)。
Private Sub TeamBreakdown(oSlide As Object)
Dim oWrkSht As Object
Dim oWrkCht As Object
Dim oLastCell As Object
Dim rst As DAO.Recordset
Dim prm As DAO.Parameter
Dim qdf As DAO.QueryDef
Dim x As Long
Dim itm As Variant
With oSlide
With .Shapes("chtTeamBreakdown")
Set oWrkSht = .oleformat.Object.worksheets(1)
Set oWrkCht = .oleformat.Object.Charts(1)
End With
End With
Set oLastCell = LastCell(oWrkSht)
With oWrkSht
.Range(.cells(1, 1), oLastCell).ClearContents
End With
Set qdf = CurrentDb.QueryDefs("SQL_REPORT_LSCTeamBreakdown")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset
x = 2
With rst
'Place the headings first.
For Each itm In .Fields
oWrkSht.cells(1, itm.CollectionIndex + 1) = itm.Name
Next itm
.MoveFirst
'Place the values.
Do While Not .EOF
For Each itm In .Fields
oWrkSht.cells(x, itm.CollectionIndex + 1) = itm.Value
Next itm
x = x + 1
.MoveNext
Loop
.Close
End With
Set oLastCell = LastCell(oWrkSht)
With oWrkSht
'Add spacer rows to the raw data (equal to the maximum value in the row above plus 2 minus the value directly above).
For x = oLastCell.row To 3 Step -1
.Rows(x).Insert Shift:=-4121, CopyOrigin:=0 '-4121 = xlDown, 0 = xlFormatFromLeftOrAbove
.Range(.cells(x, 2), .cells(x, oLastCell.Column)).FormulaR1C1 = _
"=MAX(R" & x - 1 & "C2:R" & x - 1 & "C" & oLastCell.Column & ")+2-R" & x - 1 & "C"
'Next line produces =MAX($B65536:$P65536)+2-A$2 (when entered in B3).
' .Range(.cells(x, 2), .cells(x, oLastCell.Column)).FormulaR1C1 = _
' "=MAX(R[-1]C2:R[-1]C" & oLastCell.Column & ")+2-R" & x - 1 & "C"
Next x
Set oLastCell = LastCell(oWrkSht)
oWrkCht.SetSourceData .Range(.cells(1, 1), oLastCell), 1 'xlByRows
End With
RefreshChart oSlide.Application, 6, oSlide.Shapes("chtTeamBreakdown")
Set rst = Nothing
Set qdf = Nothing
Set oWrkSht = Nothing
Set oWrkCht = Nothing
End Sub
查找最后一个单元格的代码(在公式中使用):
Public Function LastCell(wrkSht As Object, Optional col As Long = 0) As Object
Dim lLastCol As Long, lLastRow As Long
On Error Resume Next
With wrkSht
If col = 0 Then
lLastCol = .cells.Find("*", , , , 2, 2).Column
lLastRow = .cells.Find("*", , , , 1, 2).row
Else
lLastCol = .cells.Find("*", , , , 2, 2).Column
lLastRow = .Columns(col).Find("*", , , , 2, 2).row
End If
If lLastCol = 0 Then lLastCol = 1
If lLastRow = 0 Then lLastRow = 1
Set LastCell = wrkSht.cells(lLastRow, lLastCol)
End With
On Error GoTo 0
End Function