Sub Test()
Dim appWord As Object, nbP As Long, iP As Long, tabP() As String
Range("B1").Value = "Texte ""test"""
Range("A1").Value = Range("B1").Font.Name
Set appWord = CreateObject("Word.Application")
For iP = 1 To appWord.FontNames.Count
Range("A1").Value = appWord.FontNames(iP)
Range("B1").Font.Name = appWord.FontNames(iP)
Next iP
appWord.Quit
End Sub