Critère de recherche autre que par le nom

Sub AjouterMotClef(Motclef As String, Optional sep As String = ",")
'sortir si MotClef est une chaine vide
If Trim(Motclef) = "" Then Exit Sub
Dim tmp 'contiendra un tableau provisoire des mots clefs
With ThisWorkbook.BuiltinDocumentProperties("Keywords")
    'si le mot clef n'existe pas dans la chaine des mots clefs
    If InStr(1, LCase(.Value), LCase(Motclef), vbTextCompare) = 0 Then
        'obtenir un tableau temporaire des mots clefs
        tmp = Split(Trim(.Value), sep)
        'si le tableau (d'indice 0) contient au moins 1 mot clef
        If UBound(tmp) > -1 Then
               ReDim Preserve tmp(0 To UBound(tmp) + 1)
                tmp(UBound(tmp)) = Motclef
                .Value = Join(tmp, sep & " ")
        Else
            .Value = Motclef
        End If
    End If
End With
End Sub
Sub SupprimerMotClef(Motclef As String, Optional sep As String = ",")
 Dim pos As Integer: pos = 0
 With ThisWorkbook.BuiltinDocumentProperties("Keywords")
    pos = InStr(1, LCase(.Value), LCase(Motclef), vbTextCompare)
    'remplacer le motclef par "" et éliminer les doubles séparateurs
    If pos > 0 Then .Value = Replace(Replace(.Value, Motclef, "", , , vbTextCompare), sep & sep, sep)
 End With
End Sub
Sub SupprimerTousLesMotsClefs()
ThisWorkbook.BuiltinDocumentProperties("Keywords") = ""
End Sub