通过VBA导入自定义幻灯片占位符时,如何防止图像被裁剪,以便可以从Access表中添加文本?​​

时间:2019-02-03 22:45:32

标签: powerpoint-vba ms-access-2016

图像将按预期导入具有VBA代码的空白幻灯片,但是如果导入到“自定义主模板”占位符,则会被裁剪。需要将图像导入到没有占位符的占位符中,保持宽高比,并用空白的水平或垂直条填充。占位符需要考虑解释图像的图像(未覆盖)下方的文本占位符,例如印刷书籍中的图片标题。演示所需的数百张不同大小的图像(带标题)。所有这些都在MS-Access 2016数据库中引用。

Win7 Pro,Office2016。数百个图像(在一个文件夹中)以及Access表中的链接和标题。我尝试使用VBA将这些图像导入到图片和内容占位符中,但没有成功裁剪。图像的最佳结果是导入到空白幻灯片中,该幻灯片效果很好,但不允许(?)调整空白幻灯片格式的大小来添加文本框并直接通过VBA填充文本框,而不会裁剪,放大或扭曲图像。使用Imagemagick将所有图像调整为相同的高度,以尝试避免在将其导入到Custom Master幻灯片模板(图片或内容)时调整大小,但是没有用。我可以遍历从Access导出的文本文件以创建和填充文本框,或者在导入图像后在自定义母版中填充文本框,但是因为除了在导入时填充一张空白幻灯片外,我似乎无法绕开被占位符破坏的图像。 ,我不确定如何最好地进行。我知道我不能创建或引用比给定幻灯片中最初存在的占位符更多的占位符。但是我似乎找不到找到将图像放入自定义布局的占位符的方法,在那里我为文本制作了一个占位符。

' This code imports images as desired from http://www.pptfaq.com/FAQ00352_Batch_Insert_a_folder_full_of_pictures-_one_per_slide.htm   
Sub ImportABunch()

Dim strTemp As String
Dim strPath As String
Dim strFileSpec As String
Dim oSld As Slide
Dim oPic As Shape

' Edit these to suit:
strPath = "Z:\PicOfDay\20180118_PicListPNG\"
strFileSpec = "*.png"

strTemp = Dir(strPath & strFileSpec)

Do While strTemp <> ""
    Set oSld = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, Layout:=ppLayoutBlank)
    Set oPic = oSld.Shapes.AddPicture(FileName:=strPath & strTemp, _
    LinkToFile:=msoFalse, _
    SaveWithDocument:=msoTrue, _
    Left:=0, _
    Top:=0, _
    Width:=-1, _
    Height:=-1)
    ' width/height of -1 tells PPT to import the image at its "natural" size
    oSld.HeadersFooters.Footer.Visible = False
' Optionally, make it fill the slide - even if that means changing the proportions of the picture
' To do that, uncomment the following:
'  With oPic
'      .LockAspectRatio = msoFalse
'      .height = ActivePresentation.PageSetup.Slideheight
'      .width = ActivePresentation.PageSetup. Slidewidth
'  End With

' Or (with thanks to David Marcovitz) make the picture as big as possible on the slide
' without changing the proportions
' Leave the above commented out, uncomment this instead:
   With oPic
     If 3 * .Width > 4 * .Height Then
         .Width = ActivePresentation.PageSetup.SlideWidth
         .Top = 0.5 * (ActivePresentation.PageSetup.SlideHeight - .Height)
     Else
       .Height = ActivePresentation.PageSetup.SlideHeight
         .Left = 0.5 * (ActivePresentation.PageSetup.SlideWidth - .Width)
     End If
   End With

' Optionally, add the full path of the picture to the image as a tag:
'With oPic
'  .Tags.Add "OriginalPath", strPath & strTemp
'End With

    ' Get the next file that meets the spec and go round again
    strTemp = Dir
Loop

End Sub

这段代码很好用,但似乎不允许通过在正确位置创建新文本框并调整图片大小来通过VBA插入文本。

0 个答案:

没有答案