Attribute VB_Name = "ExploreRef"
Option Explicit
Option Base 1

'******************************************************************
'**** SBS www.ebsoft.org Version 1.0 03/06/2005
'******************************************************************

Type TablLink
    Nom As String
    Path As String
    SavePi As Boolean
    AutoUp As Boolean
    Locked As Boolean
    NoChar As Long
End Type

Sub VoirReferences()
Dim oShape As Shape
Dim ListForme() As TablLink
Dim i As Integer, j As Integer
Dim NewDoc As Document

    On Error Resume Next
    i = 1
    Application.ScreenUpdating = False
    
    For Each oShape In ActiveDocument.Shapes
        ReDim Preserve ListForme(i)
                
        ActiveDocument.Shapes(i).Anchor.Paragraphs(1).Range.Select
        'Numéro du 1er caractére par rapport au début du doc
        'MsgBox ActiveDocument.Shapes(i).Anchor.Paragraphs(1).Start
        
        ListForme(i).Nom = oShape.Name
        ListForme(i).Path = oShape.LinkFormat.SourceFullName
        ListForme(i).SavePi = oShape.LinkFormat.SavePictureWithDocument
        ListForme(i).AutoUp = oShape.LinkFormat.AutoUpdate
        ListForme(i).Locked = oShape.LinkFormat.Locked
        ListForme(i).NoChar = Selection.Range.Start
        i = i + 1
    Next oShape
    
    Set NewDoc = Documents.Add(DocumentType:=wdNewBlankDocument)
    For j = 0 To i
        Selection.TypeParagraph
        Selection.TypeText Text:=ListForme(j).Nom & " - Caractère No : " & ListForme(j).NoChar
        Selection.TypeParagraph
        If ListForme(j).Path <> "" Then
            Selection.TypeText Text:="Full Path : " & ListForme(j).Path
            Selection.TypeParagraph
            'Selection.TypeText Text:="Save picture : " & ListForme(j).SavePi
            'Selection.TypeParagraph
            'Selection.TypeText Text:="Auto update : " & ListForme(j).AutoUp
            'Selection.TypeParagraph
            'Selection.TypeText Text:="Locked : " & ListForme(j).Locked
            'Selection.TypeParagraph
        End If
    Next j
    
    Application.ScreenUpdating = True

End Sub

Sub GotoCarNo()
Dim iNoC As Long, sNoC As String
    sNoC = InputBox("Saisir le No du caractère à atteindre", "Atteindre")
    If Not (IsNumeric(sNoC)) Then Exit Sub
    iNoC = CLng(sNoC)
    If iNoC = 0 Then iNoC = 1
    If iNoC > ActiveDocument.Characters.Count Then iNoC = ActiveDocument.Characters.Count
    ActiveDocument.Characters(iNoC).Select
End Sub