Я обновляю диаграммы в Powerpoint 2007 из запросов в Access 2007.
Диаграммы были добавлены и настроены вручную с помощью Вставить ~ Объект ~ Диаграмма Microsoft Office Excel и должны выглядеть так (я запутал метки осей):
Эта проблема
Мой запрос 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"
Как видите, я использую в формуле x-1, а не R[-1], поскольку R[-1] возвращает строку 65536, хотя формула находится в строке 3.
Данные за диаграммой выглядят следующим образом (вы можете видеть, где формула испорчена, возвращая значение ошибки, поскольку она пытается сослаться на столбец 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
