בקשת מידע | האם אפשר לבצע עשרות החלפות ביחד?

אלף שין

@shishko כתב בבקשת מידע | האם אפשר לבצע עשרות החלפות ביחד?:

אני מקווה שיהיה לי זמן ליצור דבר כזה

@shishko כתב בבקשת מידע | האם אפשר לבצע עשרות החלפות ביחד?:

ברמת העיקרון בניתי פתרון טוב יותר

אשמח.....

@אלימיר
הבעיה היא שאין לי גישה.... [התמלול דרך אלף בוט, ואני לא רוצה להכביד על הפרומפט שלו העמוס גם כך]

shishko

@אלף-שין כתב בבקשת מידע | האם אפשר לבצע עשרות החלפות ביחד?:

אשמח.....

מצורף!
תשנה את הנתיב למה שתבחר ותיצור שם קובץ עם סיומת TXT

Sub החלפות_מרובות_מקובץ_טקסט()
    Dim filePath As String
    Dim fileNumber As Integer
    Dim fileContent As String
    Dim lines() As String
    Dim line As Variant
    Dim words As String
    Dim replac() As String
    Dim awords() As String
    'כתוב כאן את הנתיב ושם הקובץ שבחרת
    filePath = "Z:\נתוני תוכנות\Word\תבניות לתוספת\החלפות.txt"

    fileNumber = FreeFile
    Open filePath For Input As fileNumber
    fileContent = Input$(LOF(fileNumber), fileNumber)
    Close fileNumber

    lines = Split(fileContent, vbCrLf)
    
    
    If Application.CapsLock = True Then
    words = InputBox("כתוב את המילים להחלפה הפרד בין המקור למחליף באמצעות ""-"" ללא רווח אם ברצונך להוסיף כמה ערכים הפסק באמצעות ""."" ביניהם", "הוספת ערכים להחלפה")
        If words <> "" Then
        Dim wordExists As Boolean
        wordExists = False
        awords = Split(words, ".")
        For i = 0 To UBound(awords)
        For Each line In lines
            If InStr(1, line, awords(i), vbTextCompare) > 0 Then
                wordExists = True
                Exit For
            End If
        Next line
        ' בדוק אם המילים נמצאו
        If wordExists Then
            MsgBox "המילים '" & awords(i) & "' כבר קיימות בקובץ.", vbInformation
        Else
            ' אם המילים אינם קיימות, הוסף אותם לקובץ
           Open filePath For Append As fileNumber
           Print #fileNumber, awords(i)
           Close fileNumber
           MsgBox "המילים '" & awords(i) & "' נוספו לקובץ.", vbInformation
        End If
        End If
        Exit Sub
    Else
        Dim rng As Range
        For Each line In lines
        If Trim(line) <> "" Then
        replac = Split(line, "-")
            ' החלפת המילים שבקובץ
            Set rng = ActiveDocument.Content
            With rng.Find
            .Text = replac(0)
            .Replacement.Text = replac(1)
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = False
            .Execute Replace:=wdReplaceAll
            .MatchWildcards = True
            End With
        End If
        Next line
    End If
End Sub

כתיבת הערכים בקובץ היא בכל שורה כך על ידי-ע""י (כדי שהוא יבין שאתה רוצה סימון של גרשיים צריך לעשות שניים רצופים)
לפעמים בפעמיים הראשונות הוא לא מצליח להוסיף לבד ולכן תעשה זאת ביצירת הקובץ, אח"כ ניתן להפעיל את המאקרו כש capslock דלוק ואז יקפוץ חלון להוספת ערכים
בהצלחה!

יאיר י.

@shishko @אלף-שין
יש אפשרות בלחיצה על חיפוש והחלפה להגדיר את כל המילים 'על ידי' שיוחלפו ב'ע"י' וכן הלאה, יש אפשרות לשנות עם נתוני גופן(גודל, מודגש, גופן וכו')

מצרף סרטון שערכתי בנושא:
מדריך יאיר - שינוי כותרת מרובה בפעם אחת.mp4

אם לא תסתדר אשמח לעזור

יאיר דניאל

@יאיר-י. כתב בבקשת מידע | האם אפשר לבצע עשרות החלפות ביחד?:

מצרף סרטון שערכתי בנושא:
מדריך יאיר - שינוי כותרת מרובה בפעם אחת.mp4

אפשר בזיפ?

shishko

@יאיר-י. הסרטון סגור לי!
אתה אומר שיש לך דרך לעשות החלפות מרובות עם מילים קבועות אף שאני כבר לא זוכר איזה מילים בחרתי להחליף וכדו', או לעשות החלפה החלפה? (א"כ כולנו יודעים שיש אפשרות של החלפה ושאפשר להדגיש שם וכדו' אך לא זה הנושא)

יאיר י.

@shishko
יש אפשרות להחליף את הכל ביחד, ואם תרצה אשלח לך למייל את הסרטון

המייל שלי הוא 4100934@gmail.com

975

@אלף-שין כתב בבקשת מידע | האם אפשר לבצע עשרות החלפות ביחד?:

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

בקיצור יש כמה עשרות מילים די קבועות
השאלה אם יש אופציה לעשות איזה שהיא רשימת מילון של החלפה
ולאחר מכן בלחיצת כפתור אוכל בכל תוצר תמלול להחיל בבת אחת את כל ההחלפות
אשמח לעזרה מקווה שהייתי מספיק ברור

אפילו שציינת נפתר אבל אולי יעזור לאחרים
מתנצל שלא ראיתי את זה עד היום - אולי ראיתי אבל לא שמתי לב למה המדובר
בכל אופן להעתיק את המצורף ל- %AppData%\Microsoft\Word\STARTUP

1234.rar

בהצלחה רבה