Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1:B1]) Is Nothing Or [A1] = "" Then Exit Sub
Dim chemin$, doc$, Wapp As Object
chemin = ThisWorkbook.Path & "\" 'dossier à adapter éventuellement
doc = Dir(chemin & [A1] & "*" & [B1] & ".doc*") '1er fichier trouvé
If doc = "" Then MsgBox "Document Word introuvable !", 48: Exit Sub
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
On Error GoTo 0
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Wapp.Documents.Open chemin & doc
AppActivate "Word"
End Sub