Я создал лист, на котором расположены все диаграммы, а затем использовал макрос для экспорта диаграмм в PowerPoint.
Как определить порядок вставки диаграмм в презентацию? Я попытался назвать их Диаграмма 1, Диаграмма 2 и т. д., но это не сработало.
Вот код макроса:
'First we declare the variables we will be using
Dim newPowerPoint As PowerPoint.Application
Dim activeSlide As PowerPoint.Slide
Dim cht As Excel.ChartObject
'Look for existing instance
On Error Resume Next
Set newPowerPoint = GetObject(, "PowerPoint.Application")
On Error GoTo 0
'Let's create a new PowerPoint
If newPowerPoint Is Nothing Then
Set newPowerPoint = New PowerPoint.Application
End If
'Make a presentation in PowerPoint
If newPowerPoint.Presentations.Count = 0 Then
newPowerPoint.Presentations.Add
End If
'Show the PowerPoint
newPowerPoint.Visible = True
'Loop through each chart in the Excel worksheet and paste them into the PowerPoint
For Each cht In ActiveSheet.ChartObjects
'Add a new slide where we will paste the chart
newPowerPoint.ActivePresentation.Slides._
Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
newPowerPoint.ActiveWindow.View._
GotoSlide newPowerPoint.ActivePresentation.Slides.Count
Set activeSlide = newPowerPoint.ActivePresentation._
Slides(newPowerPoint.ActivePresentation.Slides.Count)
'Copy the chart and paste it into the PowerPoint as a Metafile Picture
ActiveSheet.Unprotect "password"
cht.Select
ActiveChart.ChartArea.Copy
activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
ActiveSheet.Protect "password"
'Set the title of the slide the same as the title of the chart
'activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text
'Adjust the positioning of the Chart on Powerpoint Slide
newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 1
newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 1
'activeSlide.Shapes(2).Width = 200
'activeSlide.Shapes(2).Left = 505
Next
AppActivate ("Microsoft PowerPoint")
Set activeSlide = Nothing
Set newPowerPoint = Nothing
