السلام عليكم
بارك الله فيك اخي كيماس
تعمل عندي على اوفيس 2003 عربي
بدون مشكلة
وهذا حل آخر مختصر واعم
ويعمل بتشكيل او بدون تشكيل
ويكرر التلوين في حالة تكرار الكلمة باختلاف التشكيل
Option Explicit
Sub kh_Color_Characters()
Dim SearchString, SearchChar
Dim R As Integer, H As Integer, st As Integer, sc As Integer
With Worksheets("البحث")
For R = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
.Cells(R, "B").Font.ColorIndex = 0
If Len(Trim(.Range("kh_textfind"))) <> 0 Then
SearchString = Trim(.Cells(R, "B").Text) & " "
SearchChar = Trim(.Range("kh_textfind")) & " "
H = 1
1:
On Error Resume Next
st = Application.WorksheetFunction.Search(SearchChar, SearchString, H)
If Err.Number = 0 Then
sc = InStr(st, SearchString, " ") - st
.Cells(R, "B").Characters(st, sc).Font.Color = vbRed
H = st + 1
GoTo 1
End If
End If
Next
End With
End Sub
ودمتم في حفظ الله
تلوين كلمة من اية1.rar