كيفية تغليط جميع الكلمات المحددة في نطاق الخلايا؟

في Excel، يمكن أن تساعدنا وظيفة البحث والاستبدال في العثور على أي نص محدد وإعطاء تنسيق عريض أو أي تنسيق آخر للخلايا بالكامل. لكن هل جربت من قبل أن تجعل النص المحدد فقط داخل الخلايا عريضًا وليس الخلية بأكملها كما هو موضح في لقطة الشاشة أدناه:

تغليط جميع الكلمات المحددة في نطاق الخلايا باستخدام كود VBA

تغليط جميع الكلمات المحددة في نطاق الخلايا باستخدام كود VBA

قد يساعدك الكود التالي لـ VBA في جعل النص المحدد فقط داخل محتوى الخلية عريضًا، يرجى القيام بما يلي:

1. اضغط مع الاستمرار على مفاتيح ALT + F11 لفتح نافذة Microsoft Visual Basic for Applications.

2. انقر فوق إدراج > وحدة، والصق الكود التالي في نافذة الوحدة.

كود VBA: تغليط النص المحدد في نطاق الخلايا

Sub FindAndBold()
'Updateby Extendoffice 20160711
    Dim xFind As String
    Dim xCell As Range
    Dim xTxtRg As Range
    Dim xCount As Long
    Dim xLen As Integer
    Dim xStart As Integer
    Dim xRg As Range
    Dim xTxt As String
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
    Set xRg = Application.InputBox("Please select data range:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    On Error Resume Next
    Set xTxtRg = Application.Intersect(xRg.SpecialCells(xlCellTypeConstants, xlTextValues), xRg)
    If xTxtRg Is Nothing Then
        MsgBox "There are no cells with text"
        Exit Sub
    End If
    xFind = Trim(Application.InputBox("What do you want to BOLD?", "Kutools for Excel", , , , , , 2))
    If xFind = "" Then
        MsgBox "No text was listed", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    xLen = Len(xFind)
    For Each xCell In xTxtRg
        xStart = InStr(xCell.Value, xFind)
        Do While xStart > 0
            xCell.Characters(xStart, xLen).Font.Bold = True
            xCount = xCount + 1
            xStart = InStr(xStart + xLen, xCell.Value, xFind)
        Loop
    Next
    If xCount > 0 Then
        MsgBox "number of " & CStr(xCount) & " text be bolded!", vbInformation, "Kutools for Excel"
    Else
        MsgBox "Not find the specific text!", vbInformation, "Kutools for Excel"
    End If
End Sub

3. ثم اضغط على مفتاح F5 لتشغيل هذا الكود، وسيظهر مربع منبثق لتذكيرك بتحديد نطاق البيانات الذي تريد تغليطه، انظر لقطة الشاشة:

4. وبعد ذلك انقر فوق موافق، سيظهر مربع آخر لتذكيرك بإدخال النص المحدد الذي تريد تغليطه فقط داخل الخلايا، انظر لقطة الشاشة:

5. بعد إدخال النص، يرجى النقر فوق زر موافق، وسيتم تغليط كل النص الذي حددته في النطاق المحدد، انظر لقطة الشاشة: