从excel粘贴到适合布局的powerpoint图片

我有一个Excel图片作为形状，我想将它粘贴到mny PowerPoint应用程序，它具有我已经指定的特殊布局。从excel粘贴到适合布局的powerpoint图片

Sub ExcelShapePowerpoint() 
    Dim PowerPointApp As Object 
    Dim myPresentation As Object 
    Dim mySlide As Object 
    Dim myShape As Object 

Dim pastedPic1 As Shape 

Set DestinationSheet1 = Workbooks("myExcelFile.xlsm").Sheets("myExcelSheet") 
Set pastedPic1 = DestinationSheet1.Shapes(10) 
    On Error Resume Next 

Set PowerPointApp = GetObject(class:="PowerPoint.Application") 
    If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application") 

'Handle if the PowerPoint Application is not found 
    If Err.Number = 429 Then 
    MsgBox "PowerPoint could not be found, aborting." 
    Exit Sub 
    End If 

On Error GoTo 0 

    Application.ScreenUpdating = False 

    Set myPresentation = PowerPointApp.Presentations.Add 
Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly 
    With myPresentation.PageSetup 

.SlideWidth = 961 

.SlideHeight = 540 

End With 

    pastedPic1.Copy 


    mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile 
    Set myShape = mySlide.Shapes(mySlide.Shapes.Count) 

'Set position: 
    myShape.Left = -15 

    myShape.Top = 11 

    PowerPointApp.Visible = True 
    PowerPointApp.Activate 

    Application.CutCopyMode = False 

End Sub

从代码中可以看出布局已经设置完毕。现在我想让pastedpic1完全适合PowerPoint的布局。

我该怎么办？

来源

2016-03-01 Yigit Tanverdi

你所说的 “完全适合在PowerPoint中的布局” 是什么意思？您是将图片粘贴到占位符中，还是希望图片符合幻灯片大小或其他内容？ –

确切地说，我希望它适合幻灯片的大小 –

要缩放形状MyShape的到滑动的大小，使用：

With myShape 
    .Top = 0 
    .Left = 0 
    .Width = ActivePresentation.PageSetup.SlideWidth 
    .Height = ActivePresentation.PageSetup.SlideHeight 
End With

注意，取决于你的形状和滑动的纵横比，拉伸时发生。这可以使用裁剪方法来处理。

来源

2016-03-02 14:55:36

我有一个类似的问题，但采取了另一种方法：我创建了一个PowerPoint模板，其中我添加图片占位符到图片必须插入的目的地。这种方法的优点是，您可以在PowerPoint中编辑布局，并且不必在基本代码中摆弄像素大小。

下面的例子是在VBScript中，但可以转移到VBA容易：

打开PowerPoint演示模板：

Dim powerPoint, presentation 
Set powerPoint = CreateObject("PowerPoint.Application")  
Set presentation = powerPoint.Presentations.open("C:\template.pptx")

选择占位符，并粘贴图片：

Dim slide, view, image, placeholder 
Set view = m_presentation.Windows(1).View 
Set slide = m_presentation.Slides(slideId) 
view.GotoSlide(slide.SlideIndex) 
Set placeholder = slide.Shapes(shapeName) 
placeholder.Select() 
view.Paste() 
slide.Application.CommandBars.ExecuteMso("PictureFitCrop")

将图片缩放以适合图片的大小ceholder：

slide.Application.CommandBars.ExecuteMso("PictureFitCrop")

来源

2017-10-18 07:03:51 BitSchupser

从excel粘贴到适合布局的powerpoint图片

回答

相关问题