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