Как можно предотвратить обрезку изображений при импорте в пользовательский заполнитель слайдов через VBA, чтобы текст можно было добавлять из таблицы Access? - PullRequest
Новая
       11

Как можно предотвратить обрезку изображений при импорте в пользовательский заполнитель слайдов через VBA, чтобы текст можно было добавлять из таблицы Access?

0 голосов
/ 04 февраля 2019

Изображения импортируются в пустой слайд с кодом VBA, как и ожидалось, но обрезаются, если импортируются в заполнитель Custom Master Template.Нужно, чтобы изображения импортировались в местозаполнитель без кадрирования, сохранялись пропорции, а также добавлялись пустые горизонтальные или вертикальные полосы.Заполнитель необходим для учета текстового заполнителя под изображением (не покрывающим), который объясняет изображение, как заголовок рисунка в печатной книге.Сотни изображений разных размеров, с подписями, необходимыми для презентации.Все они указаны в базе данных MS-Access 2016.

Win7 Pro, Office 2016. Сотни изображений (в папке), а также ссылки и подписи в таблице Access.Я попытался с помощью VBA импортировать эти изображения в графические и контент-заполнители без обрезки, но безуспешно.Наилучшим результатом для изображений является импорт в пустой слайд, который отлично работает, но не позволяет (?) Изменить размер пустого формата слайдов, чтобы добавить текстовое поле и заполнить его напрямую через VBA без обрезки, увеличения или иного искажения изображений.Использовал Imagemagick для изменения размера всех изображений до одинаковой высоты, чтобы попытаться обойти изменение размера при импорте в пользовательский шаблон шаблона 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, создавая новое текстовое поле в правильном месте и изменяя размер изображения.

...