0

我正在从 中Powerpoint 2007的查询更新图表Access 2007图表是使用Insert ~ Object ~ Microsoft Office Excel Chart
手动添加和设置的,应该看起来像这样(我已经混淆了轴标签):
在此处输入图像描述

问题

我的 Access 查询返回所选月份的数据,但是我需要为月份之间的空格添加两个额外的系列。

目前我将数据放在工作表中,插入空白行并使用公式计算该月的最大值,加 2 并减去该月的原始数据值。
公式的一个例子是: =MAX(R3C2:R3C17)+2-R3C
如果我逐步执行我的代码,则此公式输入正确,但如果我运行代码,它显示为=MAX(R3C2:R3C17)+2-R3C[-1](在工作表中转换为 A1 样式)并且我的图表显示为:
在此处输入图像描述 我确实尝试更新代码,所以最终结果CC[+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
4

1 回答 1

0

我将此添加为答案,但不是公认的答案,因为它是一种解决方法。

我的原始代码使用一个公式来计算间隔系列所需的值 - 这一直放置一个不正确的公式:

        '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 x

我的解决方法是使用计算最大值WorkSheetFunction.Max(),然后计算每个单元格中应该存在的值。

注意: 我必须使用oWrkSht.Parent.Parent.Worksheetfunction来访问 Powerpoint 中使用的 Excel 应用程序实例。

    '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

        'Return the maximum value in the row.
        Set rRange = .range(.cells(x - 1, 2), .cells(x - 1, oLastCell.Column))
        lMaxVal = oWrkSht.Parent.Parent.worksheetfunction.max(rRange) + 2

        'Calculate the value for each spacer cell.
        For y = 2 To oLastCell.Column
            .cells(x, y) = lMaxVal - .cells(x - 1, y)
        Next y
    Next x

这有效,但感觉像作弊......

于 2016-09-27T15:58:11.507 回答