TPE

Tavvafi@gmail.com

≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡

Sub PNG_Me()
' Exports pictures to PNG, reimports them

  Dim sPath As String
  Dim dEnlargementFactor

  ' EDIT THE FOLLOWING:
  ' Name of folder for temp files
  ' It should always end with a path separator character:
  ' \ for PC, : (colon) for Mac
  ' The folder must already exist
sPath = "Macintosh HD:temp:"

  ' We enlarge the images before exporting them
  ' The higher the enlargement factor, the higher the resolution of the converted file
  ' This also serves to "optimize" your file sizes somewhat
  dEnlargementFactor = 2

  ' =========== NO USER-SERVICEABLE PARTS PAST THIS POINT
  Dim oOriginalPic As Shape
  Dim oNewPic As Shape
  Dim oSl As Slide
  Dim oSh As Shape
  Dim dLeft As Double
  Dim dTop As Double
  Dim dheight As Double
  Dim dwidth As Double
  Dim sImageName As String

  For Each oSl In ActivePresentation.Slides
    For Each oSh In oSl.Shapes
        ' Touch only pictures
        If oSh.Type = msoPicture Then
            ' Touch only pictures that haven't yet been touched
            If Len(oSh.Tags("PINGED")) = 0 Then
                With oSh
                    sImageName = sPath & "Slide" & CStr(oSl.SlideID) & "_" & oSh.Name & ".PNG"
                    ' memorize size/position
                    dTop = .Top
                    dwidth = .width
                    dheight = .height
                    dLeft = .Left
                    ' Enlarge, then export to PNG; lock aspect ratio first
                    oSh.LockAspectRatio = msoTrue
                    oSh.height = oSh.height * dEnlargementFactor
                    oSh.Export sImageName, ppShapeFormatPNG
                    ' and delete the shape
                    .Delete
                End With
                ' import saved picture
                Set oNewPic = oSl.Shapes.AddPicture(sImageName, msoFalse, msoTrue, dLeft, dTop, dwidth, dheight)
                Call oNewPic.Tags.Add("PINGED", "PONGED")
            End If
        End If
    Next
  Next

End Sub