CODEWITHSUNDEEP
excelvbapowerpoint
Jordan
Jordan

Reputation: 363

Resize/ position shapes in PowerPoint presentation

I have old code I am repurposing for a more general use.

I have a PowerPoint presentation I want to paste specific image files into, create a new slide and then repeat until all the variable names in column A are finished.

It finds the image name in a specific file location, builds the name based on a left of variable name value, variable name values (column A) and right of variable name value. Ex. ("Device" "23" "for generic product line").

After finding this image name, it takes that image and inserts it onto a slide, resizes and positions it to the left, then finds another comparison image, places that on the same slide and resizes and positions it to the right.

The resizing and positioning no longer works as it should. It seems like the image is not being treated as a shape. I have that the first image is shape(2) from previous experimentation as there is some clipart on the slides that counts as a shape. I then had that shape(3) was image 2 for the same reason.

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

Upvotes: 0

Views: 410

Answers (1)

Steve Rindsberg
Steve Rindsberg

Reputation: 14809

Assuming that the shape you're after will be the n'th shape on a slide isn't a good idea, and in your case, there's no need to do so. This:

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

gives you a reference to the newly inserted image in the variable Shape1, so you can do this:

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

Likewise for Shape2.

Also, you do this:

Set Title = PPpres.Slides(i - 5)

Two problems here:

1) You haven't declared the variable Title, and

2) It's not good practice to use object/method/property names as variable names.

Instead:

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

Upvotes: 1

Related Questions