PowerPoint

2003でハマるポイント

埋め込み画像の参照

ファイルが無い

なぜか2003からファイルの参照が相対パス(ファイルの置いてあるフォルダから見たファイルの位置)ではなく、絶対パス(c:\temp\foo\bar.jpg)みたいな感じ)を記録するようになった。

要するにファイルを埋め込む場合、仮にフォルダ構成を同じにコピーしても、作ったマシンでしか正常に表示されないことになる。

対応策

Microsoftによると2つあるらしいが、一つはCDにパックしろという内容なのでパス。

子フォルダから先だけに置き換える方法

下のを基に作ってみた。 子フォルダの階層のみ生かす。 相対パスは面倒なのでやめた。

Sub RelPict()
   Dim oSlide As Slide
   Dim oShape As Shape
   Dim lPos As Long
   Dim strLink As String
   For Each oSlide In ActivePresentation.Slides
      For Each oShape In oSlide.Shapes
         If (oShape.Type = msoLinkedOLEObject) Or (oShape.Type = msoLinkedPicture) Or (oShape.Type = msoMedia) Then
            With oShape.LinkFormat
              PathLen = Len(oSlide.Parent.Path)
              If (InStr(.SourceFullName, oSlide.Parent.Path) = 1) And (InStrRev(.SourceFullName, "\") > 0) Then
                lPos = Len(.SourceFullName) - PathLen - 1
                strLink = Right(.SourceFullName, lPos)
                .SourceFullName = strLink
              End If
            End With
         End If
      Next oShape
   Next oSlide
End Sub

パスを全部消して同一フォルダにする方法

• ここ

によると下のソースで良いらしい。

If (oShape.Type の部分を弄るとオブジェクトを自由に指定できます。 (msoMediaを追加してあります)

※バグってました。

Sub RelPict()
   Dim oSlide As Slide
   Dim oShape As Shape
   Dim lPos As Long
   Dim strLink As String
   '
   ' Loop through the presentation checking each shape
   ' on each slide to see if it is a linked picture.
   '
   For Each oSlide In ActivePresentation.Slides
      For Each oShape In oSlide.Shapes
         If (oShape.Type = msoLinkedOLEObject) Or (oShape.Type = msoLinkedPicture) Or (oShape.Type = msoMedia) Then
            With oShape.LinkFormat
   '
   ' Search from the right hand portion of the source
   ' file name and find the first backslash "\" character.
   '
               lPos = InStrRev(.SourceFullName, "\")
   '
   ' Check to see if the link has already been modified.
   '
               If lPos <> 0 Then
   '
   ' Determine how long the file name is, by subtracting
   ' the position the "\" character was found at from
   ' the total length of the source file name.
   '
                  lPos = Len(.SourceFullName) - lPos
   '
   ' Extract the file name from the source file name, then
   ' assign the file name to the source file name, turning
   ' it into a relative path.
   '
                  strLink = Right(.SourceFullName, lPos)
                  .SourceFullName = strLink
               End If
            End With
         End If
      Next oShape
   Next oSlide
End Sub

で良いらしい。

動画その他の場合

PowerPointのマクロの資料があまりにも貧相なのでマクロをいじる気が失せた。 とりあえずpptファイルと同一フォルダに置けば移動しても大丈夫らしい。