یافتن متن در جعبه های متن در اکسل

Question

والتر یک کاربرگ دارد که تعدادی جعبه متن در آن وجود دارد. او می‌خواهد در میان آن جعبه‌های متن جستجو کند تا متن خاصی را بیابد، اما Find and Replace قادر به یافتن متن در جعبه‌های متنی نیست. او فکر می کند که آیا راهی برای جستجو در جعبه های متن وجود دارد؟

حق با والتر است. شما نمی توانید متنی را که در جعبه های متنی در اکسل قرار دارد پیدا کنید. برای آزمایش این، ما یک کتاب کار کاملاً جدید را باز کردیم، یک عبارت واحد را در آن قرار دادیم ("پیام من")، و سپس تعدادی متن و اعداد تصادفی را در سلول های دیگر در کاربرگ قرار دادیم. سپس، در حالی که کادر متن انتخاب نشده بود، Ctrl+F برای جستجوی "پیام من" فشار داده شد. اکسل با وفاداری گزارش داد که نمی تواند متن را پیدا کند، حتی اگر هنوز در جعبه متن وجود دارد.

خوشبختانه، شما می توانید متن را در یک جعبه متن با استفاده از یک ماکرو جستجو کنید. هر کادر متنی در یک کاربرگ متعلق به مجموعه Shapes است، بنابراین تنها کاری که باید انجام دهید این است که از هر یک از اعضای مجموعه عبور کنید و ببینید آیا متن مورد نظر در آن وجود دارد یا خیر. در اینجا یک ماکرو وجود دارد که یک رشته جستجو را درخواست می کند و سپس آن را در جعبه های متن جستجو می کند.

Sub FindInShape1()
    Dim rStart As Range
    Dim shp As Shape
    Dim sFind As String
    Dim sTemp As String
    Dim Response

    sFind = InputBox("Search for?")
    If Trim(sFind) = "" Then
        MsgBox "Nothing entered"
        Exit Sub
    End If
    Set rStart = ActiveCell
    For Each shp In ActiveSheet.Shapes
        sTemp = shp.TextFrame2.TextRange.Characters.Text
        If InStr(LCase(sTemp), LCase(sFind)) <> 0 Then
            shp.Select
            Response = MsgBox( _
              prompt:=shp.Name & vbCrLf & _
              sTemp & vbCrLf & vbCrLf & _
              "Do you want to continue?", _
              Buttons:=vbYesNo, Title:="Continue?")
            If Response <> vbYes Then
                Set rStart = Nothing
                Exit Sub
            End If
        End If
    Next
    MsgBox "No more found"
    rStart.Select
    Set rStart = Nothing
End Sub

این ماکرو به تمام اشکال موجود در کاربرگ نگاه می کند، نه فقط جعبه های متن. اگر ترجیح می دهید جستجوی خود را فقط به کادرهای متنی محدود کنید، می توانید به جای مجموعه Shapes از مجموعه TextBoxs عبور کنید. در هر صورت خوب کار خواهد کرد

همچنین توجه داشته باشید که این رویکرد هر بار که متن مطابق را پیدا می کند متوقف می شود (مورد متن مهم نیست) و از شما می پرسد که آیا می خواهید ادامه دهید. در عوض، ممکن است یک ماکرو بخواهید که به سادگی متن منطبق را در کادرهای متن علامت گذاری کند. این را می توان با یک ماکرو کوتاه تر انجام داد، همانطور که در اینجا نشان داده شده است:

Sub FindInShape2()
    Dim shp As Shape
    Dim sFind As String
    Dim sTemp As String
    Dim iPos As Integer
    Dim Response

    sFind = InputBox("Search for?")
    If Trim(sFind) = "" Then
        MsgBox "Nothing entered"
        Exit Sub
    End If
    sFind = LCase(sFind)
    For Each shp In ActiveSheet.Shapes
        sTemp = LCase(shp.TextFrame2.TextRange.Characters.Text)
        iPos = InStr(sTemp, sFind)
        If iPos > 0 Then
            With shp.TextFrame2.TextRange.Characters(Start:=iPos, _
              Length:=Len(sFind)).Font
                .UnderlineStyle = msoUnderlineHeavyLine
                .Bold = True
            End With
        End If
    Next
    MsgBox "Finished"
End Sub

این ماکرو با استفاده از یک خط سنگین زیر متن واقع شده خط می کشد و سپس آن را پررنگ می کند. وقتی کارتان تمام شد، احتمالاً می خواهید متن را به متن معمولی برگردانید. با استفاده از ماکرو زیر می توانید این کار را انجام دهید:

Sub ResetFont()
    Dim shp As Shape

    For Each shp In ActiveSheet.Shapes
        With shp.TextFrame2.TextRange.Characters.Font
            .UnderlineStyle = msoNoUnderline
            .Bold = False
        End With
    Next
End Sub