Всем кому вдруг понадобится такой сценарий. Все таки осилил.
Код |
---|
Sub UpdateEmbeddedChartDataRangeAndRemoveEmptyRows() If Not ActiveWindow.Selection.Type = ppSelectionShapes Then MsgBox "Пожалуйста, выделите диаграмму на слайде." Exit Sub End If Dim shp As Shape Set shp = ActiveWindow.Selection.ShapeRange(1) If Not shp.HasChart Then MsgBox "Выделенный объект не является диаграммой." Exit Sub End If Dim cht As Chart Set cht = shp.Chart Dim wb As Object Set wb = cht.ChartData.Workbook Dim ws As Object Set ws = wb.Worksheets(1) Dim i As Long, lastRow As Long lastRow = ws.Cells(ws.Rows.Count, 2).End(-4162).Row ' Удаляем полностью пустые строки в диапазоне B3:DlastRow (с конца вверх) For i = lastRow To 3 Step -1 If wb.Application.WorksheetFunction.CountA(ws.Range("B" & i & ":D" & i)) = 0 Then ws.Rows(i).Delete End If Next i ' Определяем новый lastRow lastRow = ws.Cells(ws.Rows.Count, 2).End(-4162).Row If lastRow < 3 Then MsgBox "Недостаточно данных." wb.Close False Exit Sub End If Dim dataRange As String dataRange = "B3:D" & lastRow Dim fullRangeAddress As String fullRangeAddress = "'" & ws.Name & "'!" & ws.Range(dataRange).Address(ReferenceStyle:=1) cht.SetSourceData Source:=fullRangeAddress wb.Close False MsgBox "Диаграмма обновлена: " & fullRangeAddress End Sub |