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

zinah

Board Regular
Joined
Nov 28, 2018
Messages
173
Office Version
365
Platform
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
Dropdown list*picture saved pathGROWTHINNOVATIONOPERATIONAL EXCELLENCETALENT
Card#CommitmentsNOTESCustomerSellRevenueProfitCommercialMarketPipelineNCSSSRClientLaunchScal*SalesGROWTHInnovationINNOVATIONCIContinuous ImprovementWasteLeanwhat * whyOp*sNOSSafetyPQVCSilent Operations212PID6sigmaLEANCulture4ETalentDev*RetentionTRPTrainingLead*TeamEngagePromo*CommunicateNN VoiceLearn*HREducationCore Value*PeoplecareerTALENT
NN19_CC001AAAFALSETRUEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSE1FALSE0TRUEFALSEFALSEFALSEFALSETRUEFALSEFALSEFALSETRUEFALSEFALSEFALSE3FALSEFALSETRUEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSE1
NN19_CC002BBBFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSE0FALSE0TRUEFALSETRUEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSE2FALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSETRUETRUEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSE2
NN19_CC003CCCFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSE0FALSE0FALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSE0FALSETRUEFALSETRUEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSETRUEFALSEFALSEFALSEFALSEFALSE3
NN19_CC004AAATRUEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSETRUEFALSEFALSEFALSE2FALSE0FALSEFALSEFALSEFALSEFALSEFALSEFALSETRUEFALSEFALSEFALSEFALSEFALSE1FALSEFALSEFALSEFALSEFALSEFALSETRUEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSE1
NN19_CC005BBBFALSEFALSEFALSEFALSETRUEFALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSE1FALSE0TRUEFALSEFALSEFALSEFALSEFALSETRUEFALSEFALSEFALSEFALSETRUEFALSE3FALSEFALSEFALSEFALSEFALSEFALSEFALSEFALSETRUEFALSETRUETRUEFALSEFALSEFALSEFALSEFALSEFALSEFALSE3

<tbody>
</tbody>


Thank you!
 

Some videos you may like

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

zinah

Board Regular
Joined
Nov 28, 2018
Messages
173
Office Version
365
Platform
Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,102,542
Messages
5,487,469
Members
407,602
Latest member
clang663

This Week's Hot Topics

Top