עזרה | קוד להסרת ' או " לפי התאמה אישית

דנבו

@אוריי
תלך למקום עם חברה , שיעור קורס חוג , תכיר חברים חדשים

pcinfogmach

@אוריי
מצטער שלא ירדתי לעומק דעתך בכל אופן אולי משהו כזה יעזור לך?

כרגע המאקרו מחפש רק מ- י"א עד צ"ט. מה שישמש אותך עבור רוב המופעים כולל תקי"א מאחר שהוא ימצא את האותיות י"א שבתוך סימן זה.
לחיפוש מופעים אחרים תצטרך להתאים אותו מחדש אולי זה מה שניסית לעשות עם הגימטריאות?

Sub מאקרו_חיפוש_והחלפה_פרטני()
' על ידי pcinfogmach
'
'מאקרו זה נועד להקל על חיפוש והחלפה של מופעים רבים באופן פרטני
'מאקרו זה יכול לשמש עבור כל חיפוש והחלפה שתרצו כדלהלן:
'
'פשוט יש להחליף את הקודים של החיפוש תחת
'.Text =
'ואת הקודים של ההחלפה תחת
'.Replacement.Text =
'הכללים של הקודים הם לפי תווים כלליים. אם ברצונכם להשתמש עם כללי חיפוש והחלפה רגילים יש לשנות את:
'.MatchWildcards = True
'ל- .MatchWildcards = False

nxt:
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "([י-צ])(\"")([א-ט])"
        .Replacement.Text = "\1\3"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    
    Dim userResponse As VbMsgBoxResult
    Dim replaceCount As Integer
    replaceCount = 0

    ' Find the first match
    Selection.Find.Execute
    
    ' Prompt the user to replace or not
    userResponse = MsgBox("הטקסט שנמצא הוא: " & Selection.Text & vbNewLine & vbNewLine & "להחליף או לא? ", vbYesNoCancel + vbMsgBoxRight + vbMsgBoxRtlReading, "חיפוש והחלפה")
    
    While Selection.Find.found
    
        If userResponse = vbYes Then
            ' Replace current match and count
            Selection.Find.Execute Replace:=wdReplaceOne
            replaceCount = replaceCount + 1
            GoTo nxt:
            End If
        If userResponse = vbNo Then
        GoTo nxt:
        End If
        If userResponse = vbCancel Then GoTo endr

    Wend
    
endr:
    ' Show the number of replacements made
    MsgBox "הוחלפו " & replaceCount & " מופעים."
End Sub
```kotlin

pcinfogmach

@pcinfogmach

כמה הערות לגבי המאקרו:

המאקרו הנ"ל נכתב עבור צורך מסויים מצו"ב מאקרו שתוכלו לחפש איתו מה שרק תרצו מאקרו חיפוש והחלפה פרטניים
לא ראיתי צורך שיופיע בתוך תיבת ההחלפה הטקסט לפני ואחרי מאחר שהמאקרו עובד עם חיפוש והחלפה ומסמן בתוך המסמך עצמו היכן המופע הנוכחי. תנסה ותראה. (אם חלונית ההחלפה מסתירה תוכל לגרור אותה לצד).

pcinfogmach

@אוריי
מאקרו מעודכן עם קיצורי מקשים והכל - ממש אוטומציה כמו שרצית - בהצלחה!
הוראות בפנים.
המאקרו נמצא כאן

(אגב אפשר לשנות את קיצורי המקשים כאן:)

ספויילר

והנה הקוד אם אתה רוצה לשחק אתו:

Sub Macro1()
'
' Macro1 Macro
'
'
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub
Sub Macro2()
'
' Macro2 Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "כדי"
        .Replacement.Text = "@@@@"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "כדי"
        .Replacement.Text = "@@@@"
        .Forward = False
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute
End Sub

אוריי

@pcinfogmach
כמה פרטים שיכולים להקל

להוסיף קיצור לביטול פעולה אחרונה כמו ctrl+z
להוסיף קיצור דרך לתוצאה קודמת.

pcinfogmach

@אוריי

המאקרו עודכן

כדי לבטל פעולה אחרונה אפשר להשתמש עם ctrl+z
נוסף קיצור דרך לתוצאה קודמת.

הוראות חדשות בתוך המאקרו
https://mitmachim.top/assets/uploads/files/1680032226437-חיפוש-והחלפה-פרטניים.zip

אוריי

@pcinfogmach
אתה יכול לשלוח לי את הקוד המעודכן?

pcinfogmach

@אוריי כתב בעזרה | קוד להסרת ' או " לפי התאמה אישית:

@pcinfogmach
אתה יכול לשלוח לי את הקוד המעודכן?

בבקשה:
(לא לשכוח להגדיר את הקיצורי דרך עיין ספויילר)

Public searchWord As String
Public replaceWord As String
Public useWildcards As Boolean

Sub מאקרו_חיפוש_והחלפה_פרטניים_התחלת_חיפוש()
'
' By pcinfogmach

    searchWord = InputBox(":הזן מילה או קוד לחיפוש")
    replaceWord = InputBox(":הזן מילה או קוד להחלפה")
    useWildcards = MsgBox("האם  ברצונך להשתמש בתווים כלליים?", vbYesNo + vbMsgBoxRight + vbMsgBoxRtlReading) = vbYes
        Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = searchWord
        .Replacement.Text = replaceWord
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
Selection.Find.Execute
End Sub
Sub מאקרו_חיפוש_והחלפה_פרטניים_חפש_הבא()
      With Selection.Find
        .Forward = True
        .Wrap = wdFindAsk
    End With
     
     Selection.Find.Execute

 End Sub

Sub מאקרו_חיפוש_והחלפה_פרטניים_חפש_הקודם()
      With Selection.Find
        .Forward = False
        .Wrap = wdFindAsk
    End With
     
     Selection.Find.Execute
    
 End Sub
        
Sub מאקרו_חיפוש_והחלפה_פרטניים_החלפה()

    With Selection.Find
        .Forward = True
        .Wrap = wdFindAsk
    End With
     Selection.Find.Execute Replace:=wdReplaceOne
     Selection.MoveRight Unit:=wdCharacter, Count:=1

    Selection.Find.Execute

End Sub

Sub מאקרו_חיפוש_והחלפה_פרטניים_למי_שלא_מתאים_לו_קיצורי_מקשים_עם_תפריט_בחירה()
'
' על ידי pcinfogmach
'מאקרו זה יכול לשמש עבור כל חיפוש והחלפה שתרצו

    Dim findText As String
    Dim replaceText As String
    Dim useWildcards As Boolean
    Dim userResponser As Integer
    
    userResponser = MsgBox("האם אתם רוצים להשתמש בתווים כלליים בחיפוש זה?", vbYesNo + vbMsgBoxRight + vbMsgBoxRtlReading, "חיפוש והחלפה פרטניים")
    useWildcards = (userResponser = vbYes)
    
    findText = InputBox(":הזן טקסט או קוד לחיפוש")
    replaceText = InputBox(":הזן טקסט או קוד להחלפה")
    
nxt:
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = findText
        .Replacement.Text = replaceText
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = useWildcards
    End With
    
    Dim userResponse As VbMsgBoxResult
    Selection.Find.Execute
    
    ' Prompt the user to replace or not
    userResponse = MsgBox("הטקסט שנמצא הוא: " & Selection.Text & vbNewLine & vbNewLine & "להחליף או לא? ", vbYesNoCancel + vbMsgBoxRight + vbMsgBoxRtlReading, "חיפוש והחלפה פרטניים")
    
    While Selection.Find.Found
    
        If userResponse = vbYes Then
            ' Replace current match and count
            Selection.Find.Execute Replace:=wdReplaceOne
            Selection.MoveRight Unit:=wdCharacter, Count:=1
            GoTo nxt:
            End If
        If userResponse = vbNo Then
        GoTo nxt:
        End If
        If userResponse = vbCancel Then Exit Sub

    Wend
    
End Sub

אוריי

@pcinfogmach
תודה רבה הקוד שלך עוזר לי המון הוא פשוט מקל בהרבה מהעבודה שהייתה מקודם

pcinfogmach

@אוריי
שמחתי לעזור