Изменение размера / положения VBA в PPT больше не работает - PullRequest
0 голосов
/ 14 декабря 2018

У меня есть старый код, который я использую для более общего использования, а не для предыдущего конкретного использования.У меня есть PowerPoint, в который я хочу вставить определенные файлы изображений, создать новый слайд и затем повторять, пока все имена переменных в столбце A не будут закончены.Он находит имя изображения в определенном месте файла, строит имя на основе левого значения значения переменной, значений имени переменной (столбец A) и правого значения имени переменной.Ex.(«Устройство» «23» «для общей линейки продуктов»).

После нахождения этого имени изображения оно берет это изображение и вставляет его в слайд, изменяет размеры и размещает его слева, а затем находит другое сравнениеimage, размещает его на том же слайде, изменяет его размеры и помещает его вправо.По некоторым причинам изменение размера и позиционирование больше не работает, как должно.Кажется, что изображение почему-то не рассматривается как форма.У меня есть то, что первое изображение - форма (2) из ​​предыдущего эксперимента, поскольку на слайдах есть некоторый клип-арт, который считается формой.У меня тогда была такая форма (3), было изображение 2 по той же причине.Прикрепленный код к макросу.Кто-нибудь видит причину, по которой он потерпит неудачу на этом этапе?

Sub Export_To_PowerPoint_JAH()
' Keyboard Shortcut: Ctrl+Shift+M

Dim Shape1 As PowerPoint.Shape
Dim Shape2 As PowerPoint.Shape
Dim objSlide As Slide
Dim New_Slide As Slide
Dim pptLayout As CustomLayout
Dim PP As PowerPoint.Application
Dim PPpres As PowerPoint.Presentation


'Create a PP application and make it visible
Set PP = New PowerPoint.Application
PP.Visible = msoCTrue

'Open the presentation you wish to copy to

'Opens the Template
Set PPpres = PP.Presentations.Open("A file path name to a template")

i = 7

Pre_Left = Range("H2")
Pre_Right = Range("H4")
Post_Left = Range("K2")
Post_Right2 = Range("K4")

Do

Set objSlide = PPpres.Slides(i - 5)
Set Title = PPpres.Slides(i - 5)


If Cells(i, 1) = "" Then
Exit Do
Else: End If

Variable_Name = Cells(i, 1)

'Searches Image Bank Folder for pre and post file names
If Not Range("H2") = "" Then
Image_Name_Pre = Pre_Left & " " & Variable_Name & " " & Pre_Right
Else
Image_Name_Pre = Variable_Name & " " & Pre_Right
End If

If Not Range("K2") = "" Then
Image_Name_Post = Post_Left & " " & Variable_Name & " " & Post_Right2
Else
Image_Name_Post = Variable_Name & " " & Post_Right2
End If



Set Shape1 = objSlide.Shapes.AddPicture(Range("B5") & Image_Name_Pre, msoCTrue, msoCTrue, 100, 100)




objSlide.Shapes.Item(2).Width = 300
objSlide.Shapes.Item(2).Height = 400
objSlide.Shapes.Item(2).Top = 140
objSlide.Shapes.Item(2).Left = 90


Set Shape2 = objSlide.Shapes.AddPicture(Range("B5") & Image_Name_Post, msoCTrue, msoCTrue, 100, 100)

objSlide.Shapes.Item(3).Width = 300
objSlide.Shapes.Item(3).Height = 400
objSlide.Shapes.Item(3).Top = 140
objSlide.Shapes.Item(3).Left = 500



Title.Shapes.Title.TextFrame.TextRange.Text = Cells(i, 3) & " Pre (Left) : " & Cells(i, 3) & " Post (Right) Offset=" & Cells(i, 4)

'Create new slide


Set New_Slide = PPpres.Slides.Add(PPpres.Slides.Count + 1, PpSlideLayout.ppLayoutObject)

'ActivePresentation.Slides.Add Index:=ActivePresentation.Slides.Count + 1, Layout:=ppLayoutCustom

i = i + 1



Loop

End Sub

1 Ответ

0 голосов
/ 14 декабря 2018

Предполагать, что фигура, которую вы ищете, будет n-й формой на слайде, не является хорошей идеей, и в вашем случае нет необходимости делать это.Это:

Set Shape1 = objSlide.Shapes.AddPicture(Range("B5") & Image_Name_Pre, msoCTrue, msoCTrue, 100, 100)

дает вам ссылку на вновь вставленное изображение в переменной Shape1, поэтому вы можете сделать это:

With Shape1
  .Width = 300
  .Height = 400
  .Top = 140
  .Left = 90
End With

Аналогично для Shape2.

Кроме того, вы делаете это:

Set Title = PPpres.Slides(i - 5)

Две проблемы здесь:

1) Вы не объявили переменную Title и

2) Это не очень хорошая практикаиспользуйте имена объектов / методов / свойств в качестве имен переменных.

Вместо:

Dim oTitle as Slide
Set oTitle = PPpres.Slides(i - 5)
...