[VBA] Lien Excel-Word +

Option Explicit 

Sub OuvreWordALaBonnePage() 
'http://excel.developpez.com/faq/?page=Word 
'------------- !!! IMPORTANT !!! ---------------- 
' 
'-- nécéssite d'activer la reference : 
'    'Microsoft word xx.x 0bject Library -- 
' 
'-- Sous VBE : Outils/Références cocher : 
'    'Microsoft word xx.x 0bject Library 
' 
'------------------------------------------------ 

Dim Appli As Word.Application, WordDoc As Word.Document, BookM As Variant 
Dim Cpt As Integer, NomZone As String, Chemin As String, NomDoc As String 
Dim SelectZone As Range, Wbk As Workbook 

'----- partie sous le classeur Excel ------- 
Set Wbk = ThisWorkbook 
Chemin = ThisWorkbook.Path  'Valable si le fichier word est dans le même répertoire 
                            'que le classeur excel 
                            'à remplacer par ex : Chemin = "C:\User\Mes documents" 
                            'Chemin est le chemin d'accès complet au doc word 
                            'sans "\" à la fin ET sans le nom du document!! 
                            'ça c'est pas bon : "C:\User\Mes documents\" 
                            'ça non plus : "C:\User\Mes documents\Doc1.doc" 
NomDoc = "Doc1.doc" '------------A ADAPTER : le nom de ton doc word 

'Si dans le classeur, il existe une feuille appelée "NomZones" Alors 
If FeuilleExiste(ThisWorkbook, "NomZones") Then 
    'On supprime tout ce qu'elle contient 
    With Sheets("NomZones") 
        .Activate 
        .Cells.Clear 
    End With 
'---------------------- Si elle n'existe pas 
Else 
    '------------------ on la créé 
    Sheets.Add 
    ActiveSheet.Name = "NomZones" 
End If 

'----- partie ouverture ou pas du doc word ------ 
On Error Resume Next 
Set Appli = GetObject(, "Word.Application") 
Set WordDoc = Appli.Documents(Chemin & "\" & NomDoc) 
On Error GoTo 0 
's'il est fermé, on l'ouvre 
If WordDoc Is Nothing Then 
    Set Appli = CreateObject("Word.Application") 
    Set WordDoc = Appli.Documents.Open(Chemin & "\" & NomDoc) 
    Appli.Visible = True 
End If 
WordDoc.Activate 
'on en fait la liste des signets en Feuille "NomZones" du classeur Excel 
For Each BookM In Word.ActiveWindow.Document.Bookmarks 
    Cpt = Cpt + 1 
    Sheets("NomZones").Cells(Cpt, 1) = BookM.Name 
Next BookM 
'On demande à choisir en sélectionnant la bonne cellule 
Do 
    Set SelectZone = Application.InputBox("Sélectionnez une zone de texte !", "Sélection de cellules", Type:=8) 
Loop While SelectZone.Value = "" 
NomZone = SelectZone.Value 
WordDoc.Activate 
Cpt = 0 
For Each BookM In Word.ActiveWindow.Document.Bookmarks 
    Cpt = Cpt + 1 
    If BookM.Name = NomZone Then Exit For 
Next BookM 
BookM.Select 
End Sub 

Function FeuilleExiste(wk As Workbook, stFeuille) As Boolean 
 On Error Resume Next 
 FeuilleExiste = Not (wk.Sheets(stFeuille) Is Nothing) 
End Function

Dim maVar As String, Numero, NomDoc
maVar =  "NuméroDeZone NomDuDocumentWord"
Numero = Split(maVar, " ")(0)
NomDoc = Split(maVar, " ")(1)

Dim maVar As String, Numero, NomDoc
maVar =  "NuméroDeZone NomDuDocumentWord"
Numero = Left(maVar, InStr(maVar, " ") - 1)
NomDoc = Right(maVar, Len(maVar) - InStr(maVar, " "))