choisir la page word à ouvrir

[COLOR="Red"]'--------------------------------------------------------
'Cocher la référence "Microsoft Word xx.x Object Library"
'--------------------------------------------------------[/COLOR]

Sub AtteindrePageWord()
Dim WordApp As Word.Application
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
WordApp.Selection.GoTo wdGoToPage, ActiveSheet.Index
If Err Then MsgBox "Page " & ActiveSheet.Index & " introuvable dans Word !!": Exit Sub
AppActivate WordApp.ActiveDocument.Name & " - Microsoft Word"
End Sub

Private Sub CommandButton1_Click()
[COLOR="red"]AtteindrePageWord[/COLOR]
End Sub

Sub OuvreDoc()
Dim Chemin As String, oWord As Word.Application, oDoc As Word.Document
nPage = Split(Application.Caller, Chr(32))
Chemin = "E:\blabla\blabla.doc" 'à adapter
On Error Resume Next
Set oWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
    Set oWord = CreateObject("Word.Application")
End If
On Error GoTo 0
If Dir(Chemin) <> "" Then
    Set oDoc = oWord.Documents.Open(Chemin)
    With oDoc.ActiveWindow.Selection
        .GoTo what:=wdGoToPage, Count:=CInt(nPage(1))
    End With
End If
    oWord.Visible = True
    oWord.Activate

End Sub

'--------------------------------------------------------
'Cocher la référence "Microsoft Word xx.x Object Library"
'--------------------------------------------------------
Sub AtteindrePageWord()
On Error Resume Next
With GetObject(, "Word.Application")
  If Err Then MsgBox "Ouvrez le fichier Word !!": Exit Sub
  .Selection.Goto wdGoToPage, [COLOR="Red"]Count:=[/COLOR]ActiveSheet.Index
  .Visible = True
  .Activate
End With
End Sub

'--------------------------------------------------------
'Cocher la référence "Microsoft Word xx.x Object Library"
'--------------------------------------------------------
Sub AtteindrePageWord()
Dim tablo
[COLOR="Red"]tablo = Array(1, 3, 4, 6) 'pages Word à atteindre, à adapter[/COLOR]
On Error Resume Next
With GetObject(, "Word.Application")
  If Err Then MsgBox "Ouvrez le fichier Word !!": Exit Sub
  .Selection.Goto wdGoToPage, Count:=[COLOR="red"]tablo(ActiveSheet.Index - 1)[/COLOR]
  If Err Then MsgBox "Pas de page Word correspondante...": Exit Sub
  .Visible = True
  .Activate
End With
End Sub

Private Sub CommandButton1_Click()
AtteindrePageWord [COLOR="Red"]1[/COLOR]
End Sub

Private Sub CommandButton1_Click()
AtteindrePageWord [COLOR="red"]3[/COLOR]
End Sub

'--------------------------------------------------------
'Cocher la référence "Microsoft Word xx.x Object Library"
'--------------------------------------------------------
Sub AtteindrePageWord([COLOR="red"]page As Integer[/COLOR])
On Error Resume Next
With GetObject(, "Word.Application")
  If Err Then MsgBox "Ouvrez le fichier Word !!": Exit Sub
  .Selection.Goto wdGoToPage, Count:=[COLOR="red"]page[/COLOR]
  .Visible = True
  .Activate
End With
End Sub

Private Sub Workbook_Open()
On Error Resume Next
With GetObject(, "Word.Application")
.Visible = False
.Documents.Open .ActiveDocument.Path & "\" & .ActiveDocument.Name
.Visible = True
End With
End Sub

Sub AtteindrePageWord(page As Integer)
On Error Resume Next
With GetObject(, "Word.Application")
  If Err Then MsgBox "Ouvrez le fichier Word !!": Exit Sub
  .Selection.Goto wdGoToPage, Count:=page
  .Visible = True
  ThisWorkbook.FollowHyperlink .ActiveDocument.Path & "\" & .ActiveDocument.Name
End With
End Sub