Kæder til Excel i Powerpoint

Her er lidt kode, der gennemgår alle slides med kæder og prompter dig for hver enkelt. Jeg selv haft meget glæde af det... Men det kan nemt udbygges til at lave en liste i Excel der med alle kæderne - for overblikkets skyld.

-------------

  Sub nye_kaeder_alle()
Dim sl, sh
Dim tekst As String
Dim oldchain, newchain As String
   
   
  For sl = 1 To ActivePresentation.Slides.Count
        For sh = 1 To ActivePresentation.Slides(sl).Shapes.Count
            With ActivePresentation.Slides(sl).Shapes(sh)
                If .Type = msoLinkedOLEObject Then
                    With .LinkFormat
                    oldchain = .SourceFullName
                    newchain = "G:\Analyse\SnapShots\Shapshots booking\Snapshots booking 2005.xls!Flowchart!R4C4:R19C3"
                  ' MsgBox (oldchain & " " & newchain)
                    newchain = InputBox("Her kan du skrive den nye sti.", "Powerpoint kædeopdatering", oldchain)
                      ' MsgBox newchain
                        .SourceFullName = newchain
                        .AutoUpdate = ppUpdateOptionAutomatic
                    End With
                End If
            End With
        Next sh
    Next sl
   
    ActivePresentation.UpdateLinks
 
End Sub