Sub OuvertureSignet()
'
' OuvertureSignet Macro
' Macro enregistrée le 03/05/2006 par Benjamin
'
Dim Version As String
Dim Appelant As String
Dim TextBoxNumber As Integer
Dim Texte As String
Dim TexteLenght As Long
Dim NumberLenght As Long
Dim i As Long
Dim Carac As String
Dim Buffer As String
Dim SignetNumber As String
Dim Reponse As Integer
Dim Reponse1 As Integer
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
On Error Resume Next
Version = Cells(5, 1) 'récupère le nom de fichier de la derniere version de spec
Appelant = Application.Caller
TextBoxNumber = Mid(Appelant, 14)
ActiveSheet.Shapes('Text Box ' & TextBoxNumber).Select
Texte = Selection.Text
TexteLenght = Len(Texte)
For i = 1 To TexteLenght
Carac = Mid$(Texte, i, 1)
If Carac = '(' Then
Buffer = Mid(Texte, i + 1)
End If
Next i
NumberLenght = Len(Buffer)
If NumberLenght = 0 Then
Reponse = MsgBox('Rentrer le numéro de signet entre parenthèses' & Chr(13) & _
Chr(10) & 'Exemple : Fonction Minj (12)', vbOKOnly)
Else
Reponse = vbOK
SignetNumber = Left(Buffer, NumberLenght - 1)
Set WordApp = CreateObject('word.application') 'ouvre session word
Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & '\\SpecDeTestNR_' & Version & '.doc', _
ReadOnly:=True) 'ouvre la spec en lecture seule
WordApp.Visible = False 'word masqué pendant l'operation
If ActiveDocument.Bookmarks.Exists('signet' & SignetNumber) = True Then
WordDoc.Close
WordApp.Quit
Reponse1 = vbOK
ThisWorkbook.FollowHyperlink (ThisWorkbook.Path & '\\SpecDeTestNR_' & Version & _
'.doc#signet' & SignetNumber)
Else
WordDoc.Close
WordApp.Quit
Reponse1 = MsgBox('Le signet n'existe pas dans le doc Word' & Chr(13) & _
Chr(10) & 'Créez le signet comme suit :' & Chr(13) & _
Chr(10) & 'signet12 avec 12 le numéro du paragraphe dans la spec', vbOKOnly)
End If
End If
End Sub