Call a specific picture (PNG) to PPTX according to condition

Z

zinah

Active Member
Joined
Nov 28, 2018
Messages
368
Office Version
  1. 365
Platform
  1. Windows
Hi,

I have a list in excel sheet that has themes (words analysis) this list is generated from pictures that have these words. What I need is to create a macro to call any picture to pptx if it meets the condition below:

If I choose the theme "Growth", then I need all the pictures that under is them to be called and pasted in my pptx.
Below is the example of my list and I have a simple macro that calls the picture but without a condition, here's the macro:

Code: 
Sub SavePDF()Dim PowerPointApp As Object
Dim myPPTX As Object
Dim mySlide As Object
Dim pptxNm As String
Dim oPicture As Object


CONFIRM_PPTX_APP:
'Create an Instance of PowerPoint
  On Error Resume Next
    'Is PowerPoint already opened?
      Set PowerPointApp = GetObject(class:="PowerPoint.Application")
    'Clear the error between errors
      Err.Clear
    'If PowerPoint is not already open then open PowerPoint
        If PowerPointApp Is Nothing Then
            'Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
            With pptNm.Validation
                .Delete 'delete previous validation
            End With
            MsgBox "No PowerPoint file is open. Please open the PowerPoint file to where you " & _
                        "would like to export this table.", vbOKOnly + vbCritical, ThisWorkbook.Name
        Exit Sub
        End If


'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




pptxNm = "Cards.pptm"
Set myPPTX = PowerPointApp.Presentations(pptxNm)


PowerPointApp.Visible = True
PowerPointApp.Activate




'Adds second slide
Set mySlide = myPPTX.Slides.Add(myPPTX.Slides.Count + 1, 12)
mySlide.Select


'mySlide.Shapes.AddOLEObject Left:=10, Top:=10, Width:=(7.5 * 72), Height:=(10 * 72), _
    Filename:=[B1].Value & "\" & [A132].Value & ".pdf", displayasicon:=msoFalse, link:=msoTrue


Set oPicture = mySlide.Shapes.AddPicture([B1].Value & "\" & [A132].Value & ".png", _
    msoFalse, msoTrue, Left:=10, Top:=10, Width:=(7.5 * 72), Height:=(10 * 72))


With oPicture
  .PictureFormat.CropLeft = 0
  .PictureFormat.CropTop = 0
  .PictureFormat.CropRight = 0
  .PictureFormat.CropBottom = oPicture.Height / 1.85
  .Name = [A132].Value
End With






End Sub

[TABLE="width: 3718"]
<tbody>[TR]
[TD]Dropdown list[/TD]
[TD]*picture saved path[/TD]
[TD][/TD]
[TD]GROWTH[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]INNOVATION[/TD]
[TD][/TD]
[TD="colspan: 3"]OPERATIONAL EXCELLENCE[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]TALENT[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Card#[/TD]
[TD]Commitments[/TD]
[TD]NOTES[/TD]
[TD]Customer[/TD]
[TD]Sell[/TD]
[TD]Revenue[/TD]
[TD]Profit[/TD]
[TD]Commercial[/TD]
[TD]Market[/TD]
[TD]Pipeline[/TD]
[TD]NCS[/TD]
[TD]SSR[/TD]
[TD]Client[/TD]
[TD]Launch[/TD]
[TD]Scal*[/TD]
[TD]Sales[/TD]
[TD]GROWTH[/TD]
[TD]Innovation[/TD]
[TD]INNOVATION[/TD]
[TD]CI[/TD]
[TD]Continuous Improvement[/TD]
[TD]Waste[/TD]
[TD]Lean[/TD]
[TD]what * why[/TD]
[TD]Op*s[/TD]
[TD]NOS[/TD]
[TD]Safety[/TD]
[TD]PQVC[/TD]
[TD]Silent Operations[/TD]
[TD="align: right"]212[/TD]
[TD]PID[/TD]
[TD]6sigma[/TD]
[TD]LEAN[/TD]
[TD]Culture[/TD]
[TD]4E[/TD]
[TD]Talent[/TD]
[TD]Dev*[/TD]
[TD]Retention[/TD]
[TD]TRP[/TD]
[TD]Training[/TD]
[TD]Lead*[/TD]
[TD]Team[/TD]
[TD]Engage[/TD]
[TD]Promo*[/TD]
[TD]Communicate[/TD]
[TD]NN Voice[/TD]
[TD]Learn*[/TD]
[TD]HR[/TD]
[TD]Education[/TD]
[TD]Core Value*[/TD]
[TD]People[/TD]
[TD]career[/TD]
[TD]TALENT[/TD]
[/TR]
[TR]
[TD]NN19_CC001[/TD]
[TD]AAA[/TD]
[TD][/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD]1[/TD]
[TD="align: center"]FALSE[/TD]
[TD]0[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD]3[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]NN19_CC002[/TD]
[TD]BBB[/TD]
[TD][/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD]0[/TD]
[TD="align: center"]FALSE[/TD]
[TD]0[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD]2[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]NN19_CC003[/TD]
[TD]CCC[/TD]
[TD][/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD]0[/TD]
[TD="align: center"]FALSE[/TD]
[TD]0[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD]0[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]NN19_CC004[/TD]
[TD]AAA[/TD]
[TD][/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD]2[/TD]
[TD="align: center"]FALSE[/TD]
[TD]0[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD]1[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]NN19_CC005[/TD]
[TD]BBB[/TD]
[TD][/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD]1[/TD]
[TD="align: center"]FALSE[/TD]
[TD]0[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]FALSE[/TD]
[TD]3[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]TRUE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD="align: center"]FALSE[/TD]
[TD]3[/TD]
[/TR]
</tbody>[/TABLE]


Thank you!
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
Here's an updated macro, what I need is instead of having the pictures in one slide, I need a picture in each slide. How can I do that?

Code: 
Sub CreatePagePerComment()Dim PowerPointApp As Object
Dim myPPTX As Object
Dim mySlide As Object
Dim pptxNm As String


Dim oPicture As Object


CONFIRM_PPTX_APP:
'Create an Instance of PowerPoint
  On Error Resume Next
    'Is PowerPoint already opened?
      Set PowerPointApp = GetObject(class:="PowerPoint.Application")
    'Clear the error between errors
      Err.Clear
    'If PowerPoint is not already open then open PowerPoint
        If PowerPointApp Is Nothing Then
            'Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
            With pptNm.Validation
                .Delete 'delete previous validation
            End With
            MsgBox "No PowerPoint file is open. Please open the PowerPoint file to where you " & _
                        "would like to export this table.", vbOKOnly + vbCritical, ThisWorkbook.Name
        Exit Sub
        End If


'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




pptxNm = "Commitment Cards.pptm"
Set myPPTX = PowerPointApp.Presentations(pptxNm)


PowerPointApp.Visible = True
PowerPointApp.Activate




'Adds second slide
'MsgBox SlideShowWindows(1).View.Slide.SlideIndex
Dim Nm_shp As Shape, sld_no As Integer
Dim pIndex As Integer, pName As String


    sld_no = myPPTX.Slides.Count
    pName = "Blue Transition"
    pIndex = 3
    
ADD_NEW_SLIDE:
Dim SlideCnt As Integer
    Set mySlide = myPPTX.Slides.Add(sld_no + 1, 12)
    mySlide.Select
    mySlide.CustomLayout = myPPTX.Designs("NN_PPTX_Theme").SlideMaster.CustomLayouts(pIndex)


'mySlide.Shapes.AddOLEObject Left:=10, Top:=10, Width:=(7.5 * 72), Height:=(10 * 72),
'   Filename:=[B1].Value & "\" & [A132].Value & ".pdf", displayasicon:=msoFalse, link:=msoTrue


For Each cel In [A3:A6]


If Cells(cel.Row, [A1].Column).Value <> "" Then
Set oPicture = mySlide.Shapes.AddPicture([B1].Value & "\" & cel.Value & ".png", _
    msoFalse, msoTrue, Left:=10, Top:=10, Width:=(6 * 72), Height:=(7 * 72))
Set oSlide = myPPTX.Slides(1)
With oPicture
  .Width = 7 * 72
  .Height = 8 * 72
  .PictureFormat.CropLeft = 0
  .PictureFormat.CropTop = 0
  .PictureFormat.CropRight = 0
  .PictureFormat.CropBottom = oPicture.Height / 1.85
  .Name = cel.Value
  .Line.Weight = 0.5
  .Line.Visible = msoTrue
  .LockAspectRatio = msoTrue
  .Left = 1.5 * 72
  .Top = 1.5 * 72
        With myPPTX.PageSetup
            oPicture.Left = (.SlideWidth \ 2) - (oPicture.Width \ 2)
            oPicture.Top = (.SlideHeight \ 2) - (oPicture.Height \ 2)
        End With
End With
End If






End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
VBA code for Excel tables into ppt - automation
Replies
3
Views
3K
Trebor76
T
C
  • Question Question
Replacing PowerPoint Input using Find and Replace Arrays from Excel through VBA
Replies
0
Views
2K
ckcs
C
A
  • Question Question
Export multiple Ranges/Charts to PowerPoint
Replies
1
Views
949
abc_xyz
A
S
  • Question Question
VBA To copy multiple excel range and Paste it on the same slide with positioning
Replies
0
Views
2K
Sumit_123
S
B
  • Question Question
Excel VBA Paste Range powerpoint actual filename
Replies
1
Views
896
benposaner
B

Forum statistics

Threads
1,224,816
Messages
6,181,141
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top