PPT2000: Macro to Embed Linked Images into Presentation (241378)

MORE INFORMATION

NOTE: The following macro examples work only in PowerPoint. Visual Basic for Applications macros are not supported by the Microsoft PowerPoint Viewer. For additional information, click the following article number to view the article in the Microsoft Knowledge Base:Microsoft provides programming examples for illustration only, without warranty either expressed or implied. This includes, but is not limited to, the implied warranties of merchantability or fitness for a particular purpose. This article assumes that you are familiar with the programming language that is being demonstrated and with the tools that are used to create and to debug procedures. Microsoft support engineers can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific requirements. The following macro checks each slide for linked images. If it finds a linked image, the macro then gets the location and file name for the original image, and gets the size, position, and z-order of the image on the slide. It then deletes the current image, and embeds the picture in the exact same position and size. It then repeats the search.

NOTE: You must run this macro on the computer that has access to the linked picture files. If you do not, the macro cannot embed the images into the presentation.

Sub UnlinkPicture()
   ' Enable the error handler.
   '
   On Error GoTo ErrorHandler
   
   Dim oSlide As Slide
   Dim oShape As Shape
   Dim strPath As String
   Dim fHt As Single
   Dim fWd As Single
   Dim fTop As Single
   Dim fLeft As Single
   Dim fOrder As Single
   Dim lIndex As Long
   
   ' Check to see if the presentation is in the correct view.
   ' Raise the custom error message 555.
   '
   If ActiveWindow.ViewType <> ppViewNormal And ActiveWindow.ViewType _
        <> ppViewSlide Then
      Err.Raise 555, "Unlink Picture Macro", _
        "Not in Slide View or Normal View"
   End If

   ' Check to see if the presentation has no slides.
   ' Raise the custom error message 556.
   '
   If ActivePresentation.Slides.Count = 0 Then
      Err.Raise 556, "Unlink Picture Macro", _
        "Presentation contains no slides"
   End If

   ' Loop through each slide in the presentation.
   '
   For Each oSlide In ActivePresentation.Slides
      
   ' On the current slide, find those pictures that are
   ' linked, and get the positon, size, layer, and name
   ' of the image. Then delete it from the slide.
   '
      With oSlide
         For Each oShape In .Shapes
            If oShape.Type = msoLinkedPicture Then
               strPath = oShape.LinkFormat.SourceFullName
               fHt = oShape.Height
               fWd = oShape.Width
               fTop = oShape.Top
               fLeft = oShape.Left
               fOrder = oShape.ZOrderPosition
               oShape.Delete
         
   ' Create a new picture from the same file, and original settings.
   '
               Set oShape = _
      .Shapes.AddPicture(strPath, msoFalse, msoTrue, fLeft, fTop, fWd, fHt)
               
   ' Reposition the image back to its orginal Zorder layer.
   '
               While oShape.ZOrderPosition > fOrder
                  oShape.ZOrder msoSendBackward
               Wend
   
            End If
         Next oShape
      End With
   Next oSlide
   Exit Sub
ErrorHandler:
   ' Create Error message and raise dialog box with error message.
   '
   ErrMsg = "Error " & Err.Number & ": " & Err.Source & vbNewLine _
     & Err.Description
   MsgBox ErrMsg, vbCritical, "Error Message"

End Sub