从VBA到PowerPoint的多个excel工作表中调整文本大小和更改不同数组的位置

Question

我在这方面是新手，但我在这方面很吃力。我有一个基本的功能代码，它打开PP和输入数据从我的excel表格。但它会自动居中每个工作表的数组和文本看起来非常小。我希望能够基本上使文本在不同的尺度更大，并重新定位一对数组在每个工作表上，我认为合适。我知道填充我们的数组有点截断，所以我认为我需要将其分开，以便将自定义尺寸应用于每个工作表。提前谢谢你。

Sub ExportMultipleRangeToPowerPoint_Method1()
'Declare PowerPoint Variables
Dim PPTApp As PowerPoint.Application
Dim PPTPres As PowerPoint.Presentation
Dim PPTSlide As PowerPoint.Slide

'Opens a new PowerPoint presentation based on template and pastes data into Slide 2 of Powerpoint from Excel
Dim PPapp As PowerPoint.Application, PPpres As PowerPoint.Presentation, PPslide As PowerPoint.Slide, PPShape As Object
Dim XLws As Worksheet

'Declare Excel Variables
Dim ExcRng As Range
Dim RngArray As Variant
Dim ShtArray As Variant

'Populate our arrays
RngArray = Array("A1:E16", "C2:E6", "B2:D6")
ShtArray = Array("Summary", "Sheet2", "Sheet3")
'Create a new instance of PowerPoint
Set PPTApp = New PowerPoint.Application
PPTApp.Visible = True

'Create a new Presentation
Set PPTPres = PPTApp.Presentations.Add

'Loop through the range array, create a slide for each range, and copy that range on to the slide.
For x = LBound(RngArray) To UBound(RngArray)

'Set a reference to the range
Set ExcRng = Worksheets(ShtArray(x)).Range(RngArray(x))
'Copy the range
ExcRng.Copy

'Create a new Slide
Set PPTSlide = PPTPres.Slides.Add(x + 1, ppLayoutBlank)

'Paste the range in the slide
PPTSlide.Shapes.Paste

Next x

End Sub

Answer 1

Try

' width, height, left, top
ImgArray = Array("300,300,100,100", _
"200,200,200,200", _
"150,150,150,150")
'Create a new instance of PowerPoint
Set PPTApp = New PowerPoint.Application
PPTApp.Visible = True

'Create a new Presentation
Set PPTPres = PPTApp.Presentations.Add

'Loop through the range array, create a slide for each range, and copy that range on to the slide.
Dim x
For x = LBound(RngArray) To UBound(RngArray)

'Set a reference to the range
Set ExcRng = Worksheets(ShtArray(x)).Range(RngArray(x))
'Copy the range
ExcRng.Copy

'Create a new Slide
Set PPTSlide = PPTPres.Slides.Add(x + 1, ppLayoutBlank)

'Paste the range in the slide
ar = Split(ImgArray(x), ",")
With PPTSlide.Shapes.PasteSpecial(ppPasteOLEObject)
.Width = ar(0)
.Height = ar(1)
.Left = ar(2)
.Top = ar(3)
End With

Next x