想从excel到powerpoint复制粘贴时调整graphics的形状和定位

我正在通过VBA中的macros复制粘贴graphics从excel到powerpoint，但是我不确定在powerpoint中调整graphics和定位graphics的语法是什么。 我想将graphics移动到页面的中间，我需要的形状比粘贴的更小。

我使用的代码是：

Sub CreatePowerPoint() 'Add a reference to the Microsoft PowerPoint Library by: '1. Go to Tools in the VBA menu '2. Click on Reference '3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay '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 cht.Select ActiveChart.ChartArea.Copy activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select ' '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 = 15 newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 125 activeSlide.Shapes(2).Width = 200 activeSlide.Shapes(2).Left = 505 Next AppActivate ("Microsoft PowerPoint") Set activeSlide = Nothing Set newPowerPoint = Nothing End Sub 

Answer 1

我们走吧，这应该让你走。 我曾经在那里做过一些改变。 您可以在代码中resize，并自动居中。

 Sub CreatePowerPoint() 'Add a reference to the Microsoft PowerPoint Library by: '1. Go to Tools in the VBA menu '2. Click on Reference '3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay '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 -CHANGES MADE cht.Select ActiveChart.ChartArea.Copy 'CHANGES MADE Dim obj As Object Set obj = activeSlide.Shapes.Paste '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 -CHANGES MADE obj.Width = 500 'Adjust width and height here obj.Height = 300 With newPowerPoint.ActiveWindow.Presentation.PageSetup obj.Left = (.SlideWidth \ 2) - (obj.Width \ 2) obj.Top = (.SlideHeight \ 2) - (obj.Height \ 2) End With Next AppActivate ("Microsoft PowerPoint") Set activeSlide = Nothing Set newPowerPoint = Nothing End Sub