2

形状として Excel の画像があり、既に指定した特別なレイアウトを持つ mny 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

コードから明らかなように、レイアウトはすでに設定されています。ここで、貼り付けたpic1をPowerPointのレイアウトに完全に合わせたいと思います。

私は何をすべきか ？

4

2 に答える 2

0

シェイプmyShapeをスライドのサイズに合わせてスケーリングするには、次を使用します。

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

シェイプとスライドの縦横比によっては、ストレッチが発生する可能性があることに注意してください。これは、トリミング方法を使用して処理できます。

于 2016-03-02T14:55:36.200 に答える
0

私は同様の問題を抱えていましたが、別のアプローチを取りました。写真を挿入する必要がある宛先に写真のプレースホルダーを追加する PowerPoint テンプレートを作成しました。このアプローチには、PowerPoint でレイアウトを編集でき、基本コードでピクセル サイズをいじる必要がないという利点があります。

次の例は VBScript ですが、VBA に簡単に変換できます。

  1. PowerPoint テンプレートを開きます。

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

  2. プレースホルダーを選択し、画像を貼り付けます。

    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")

  3. プレースホルダーのサイズに合わせて画像を拡大縮小します。

    slide.Application.CommandBars.ExecuteMso("PictureFitCrop")
于 2017-10-18T07:03:51.083 に答える