הצעת ייעול | יצירת מילון תורני להגהה בוורד

[דמבלדור]

@צבי-צ טוב, התקנתי את זה, מקווה שזה יעבוד,
תודה!

[menajemmendel]

@דאנציג אני ניסית בעבר כמה פעמים ומשום מה לא עבד לי, בעיקרון חשבתי רעיון מאד פשוט, [זה מה שניסיתי בזמנו] לקחת כמה ספרים ענקיים בארמית (ש''ס ראשונים וכו') ולהפוך אותם במילון, כל המילים שלהם, זה סיפור מאד פשוט.
לקחתי טקסט של ש''ס
החלפתי את כל הרווחים לאנטרים
הכנסתי את זה באקסל אחד ארוך
עשיתי סינון שאותו מילה לא יופיעה פעמיים
העתקתי את זה חזרה לקובץ טקסט ושמרתי את זה עם סיומת של מילון

אבל משום מה כשהוספתי את זה לוורד לא עבד.

[צבי צ]

@menajemmendel כתב:

העתקתי את זה חזרה לקובץ טקסט ושמרתי את זה עם סיומת של מילון

תפתח את הקובץ המקורי ע"י פנקס הרשימות ותדביק את הרשימה שלך שם.

[צבי צ]

@דמבלדור כתב:

אם יש מישהו בעניין

באתר העריכה של אוצריא 'שיפצו' את המילון והוסיפו לו הרבה מילים, וכמו"כ עשו ניפוי שגיאות אוטומטי, אולי הרב @י.-פל. יסכים להעלות אותו לטובת הציבור?

[menajemmendel]

@צבי-צ אוקיי חבר'ה עשיתי מילון של כל המילים של כל הספרים שיש לי באוצריא
אבל אני רואה שיש שם מלא מילים שלא קיימות, כנראה הם בגלל שגיאות של הסריקה וכו', אני כאן לרשותכם אם יש לכם רעיון מה ניתן לעשות לפטור את הבעיה
מדובר על כמיליון וחצי מילים (מתוך סה''כ של יותר מ400 מיליון מילים שיש באוצריא)

לא ניסיתי להתקין אותו בוורד עדייןמילון_מאוחד.TXT

[דאנציג]

@menajemmendel כתב:

אבל אני רואה שיש שם מלא מילים שלא קיימות, כנראה הם בגלל שגיאות של הסריקה וכו', אני כאן לרשותכם אם יש לכם רעיון מה ניתן לעשות לפטור את הבעיה

לדעתי כדאי לעשות רק מספרי יסוד כבבלי וכדו', כי ישנם שגיאות רבות, וחוץ משגיאות ישנם מילים רבות שאינם תיקניות גם לא בתורני, כך שזה לא באמת עוזר.

מדובר על כמיליון וחצי מילים (מתוך סה''כ של יותר מ400 מיליון מילים שיש באוצריא)

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

אולי לבנות איזה שהוא תוסף לוורד שיאפשר מילים נרדפות וכדו' מהמילון הזה...

[menajemmendel]

@דאנציג כתב:

לדעתי כדאי לעשות רק מספרי יסוד כבבלי וכדו', כי ישנם שגיאות רבות, וחוץ משגיאות ישנם מילים רבות שאינם תיקניות גם לא בתורני, כך שזה לא באמת עוזר.

הבעיה העיקרית שבגללה לא מספיק ספרי יסוד, הוא בגלל שהמילון לא ''מבין'' הטיות, דהיינו אלא צריך להכניס כל מילה בנפרד,
לדגומא אמרי
אזי יש לנו
דאמרי
אדאמרי
קאמרי
דקאמרי
ואמרי
ודאמרי
אמרינן
דאמרינן
אדאמרינן
דקאמרינן
ודאמרינן

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

[צבי צ]

@menajemmendel
את זה אפשר לפתור בקלות לבחור את כל המילים ולהוסיף את ההטיות המקובלות.

[menajemmendel]

@צבי-צ אז יצא לך הרבה יותר מילים מאילו לקחת מכל הספרים, חוץ מזה המון מילים שלא קשרורות, כי יש הטיות שמתאימות רק לפעלים, ויש שרק לעצמים וכו'

[דמבלדור]

@menajemmendel לא הבנתי, במילון המובנה של וורד גם הכניסו כל מילה עם כל אותיות מ ש ה ו כ ל ב בנפרד?

[יאיר דניאל]

@menajemmendel יש‌​‌‌​‌​​​​​‌ מישהו שיצר כזה מאקרו להוספת הטיות (פורסם בפורום - לא זוכר מי) - אולי זה ישמש אותך/אתכם - אני משתמש בזה בעת הוספת מילה חדשה למילון - אני מוסיף דרכו - וכך זה מוסיף לי גם את כל ההטיות

מצורף המאקרו שלו:

Sub תיקון_אוטומטי_הוספת_ערך()
    Dim mila As String, tikun As String
    Dim prefixes As Variant, p As Variant
    prefixes = Array("ש", "ו", "ה", "שה", "כשה", "מ", "ד", "ל", "כ", "וב", "ב", "דה")
    mila = InputBox("הזן מילה שגויה (הפעולה תוסיף אוטומטית גם תחיליות):", "הוספה חכמה לתיקון אוטומטי")
    If mila = "" Then
        MsgBox "לא נבחרה מילה, הפעולה בוטלה!", vbMsgBoxRight + vbMsgBoxRtlReading + vbExclamation
        Exit Sub
    End If
    tikun = InputBox("רשום את המילה המתוקנת:", "הוספה חכמה לתיקון אוטומטי", mila)
    If tikun = "" Then
             Exit Sub
    End If
    AutoCorrect.Entries.Add Name:=mila, value:=tikun
    For Each p In prefixes
        AutoCorrect.Entries.Add Name:=(p & mila), value:=(p & tikun)
    Next p
    MsgBox "הערך '" & mila & "' וכל התחיליות הנלוות נוספו/עודכנו בהצלחה!", vbMsgBoxRight + vbMsgBoxRtlReading + vbInformation
End Sub

Sub תיקון_אוטומטי_הסרת_ערך()
    Dim mila_to_remove As String
    Dim prefixes As Variant, p As Variant
    Dim deletedCount As Long
    prefixes = Array("ש", "ו", "ה", "שה", "כשה", "מ", "ד", "ל", "כ", "וב", "ב", "דה")
    deletedCount = 0
    mila_to_remove = InputBox("הזן את המילה השגויה להסרה (הפעולה תסיר גם את כל התחיליות):", "הסרה מלאה מתיקון אוטומטי")
    If mila_to_remove = "" Then Exit Sub
    On Error Resume Next
    AutoCorrect.Entries(mila_to_remove).Delete
    If Err.Number = 0 Then
        deletedCount = deletedCount + 1
    End If
    Err.Clear
    For Each p In prefixes
        AutoCorrect.Entries(p & mila_to_remove).Delete
        If Err.Number = 0 Then
            deletedCount = deletedCount + 1
        End If
        Err.Clear
    Next p
    On Error GoTo 0
    If deletedCount > 0 Then
        MsgBox deletedCount & " רשומות הקשורות ל-'" & mila_to_remove & "' הוסרו בהצלחה.", _
               vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "ההסרה הושלמה"
    Else
        MsgBox "הערך '" & mila_to_remove & "' (וכל תחילית קשורה) לא נמצא ברשימת התיקונים האוטומטיים.", _
               vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, "לא נמצא ערך"
    End If
End Sub

Sub תיקון_אוטומטי_ייבוא_מטבלה_שדרוג()
    Dim tbl As Table
    Dim i As Long
    Dim mila As String, tikun As String
    Dim prefixes As Variant, p As Variant
    Dim totalRows As Long, processedCount As Long, updatedCount As Long
    Dim isUpdate As Boolean
    If ActiveDocument.Tables.Count = 0 Then
        MsgBox "לא נמצאה טבלה במסמך הפעיל.", _
               vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, "שגיאה: לא נמצאה טבלה"
        Exit Sub
    End If
    If MsgBox("מאקרו זה ישדרג את כל הערכים מהטבלה (יוסיף חדשים, יעדכן קיימים, ויוסיף לכולם תחיליות).", _
              vbYesNo + vbQuestion + vbMsgBoxRight + vbMsgBoxRtlReading, "אישור שדרוג") = vbNo Then
        Exit Sub
    End If
    Application.ScreenUpdating = False
    prefixes = Array("ש", "ו", "ה", "שה", "כשה", "מ", "ד", "ל", "כ", "דה")
    Set tbl = ActiveDocument.Tables(1)
    totalRows = tbl.Rows.Count
    processedCount = 0
    updatedCount = 0
    For i = 2 To totalRows
        Application.StatusBar = "מעבד שורה " & i - 1 & " מתוך " & totalRows - 1 & "..."
        mila = Trim(Left(tbl.Cell(i, 1).Range.Text, Len(tbl.Cell(i, 1).Range.Text) - 2))
        tikun = Trim(Left(tbl.Cell(i, 2).Range.Text, Len(tbl.Cell(i, 2).Range.Text) - 2))
        If Len(mila) > 0 And Len(tikun) > 0 Then
            isUpdate = False
            On Error Resume Next
            Dim dummyValue As String
            dummyValue = AutoCorrect.Entries(mila).value
            If Err.Number = 0 Then
                isUpdate = True
            End If
            Err.Clear
            On Error GoTo 0
            If isUpdate Then
                updatedCount = updatedCount + 1
                AutoCorrect.Entries(mila).Delete
            End If
            AutoCorrect.Entries.Add Name:=mila, value:=tikun
            For Each p In prefixes
                On Error Resume Next
                AutoCorrect.Entries(p & mila).Delete
                On Error GoTo 0
                AutoCorrect.Entries.Add Name:=(p & mila), value:=(p & tikun)
            Next p
            processedCount = processedCount + 1
        End If
    Next i
    Application.StatusBar = False
    Application.ScreenUpdating = True
    MsgBox "תהליך השדרוג הסתיים בהצלחה!" & vbCrLf & vbCrLf & _
           processedCount & " ערכים מהטבלה עובדו." & vbCrLf & _
           updatedCount & " מתוכם היו עדכונים לערכים קיימים.", _
           vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "השדרוג הושלם"
End Sub

Sub תיקון_אוטומטי_ייצוא_רשימה_לטבלה()
    Dim entry As AutoCorrectEntry
    Dim tbl As Table
    Dim msg As String
    Dim totalEntries As Long, i As Long
    If Not ActiveDocument Is Nothing Then
        msg = "מאקרו זה ייצור טבלה במסמך הנוכחי עם כל רשימת התיקונים האוטומטיים שלך." & vbCrLf & _
              "מומלץ להפעיל אותו במסמך חדש וריק." & vbCrLf & vbCrLf & "להמשיך?"
        If MsgBox(msg, vbYesNo + vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "ייצוא רשימה") = vbNo Then
            Exit Sub
        End If
        Application.ScreenUpdating = False
        totalEntries = Application.AutoCorrect.Entries.Count
        If totalEntries = 0 Then
            MsgBox "לא נמצאו רשומות תיקון אוטומטי לייצא.", _
                   vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "אין רשומות"
            Application.ScreenUpdating = True
            Exit Sub
        End If
        Set tbl = ActiveDocument.Tables.Add(Range:=Selection.Range, NumRows:=totalEntries + 1, NumColumns:=2)
        With tbl
            .Borders.Enable = True
            .AllowAutoFit = False
            .Columns(1).SetWidth CentimetersToPoints(6), wdAdjustNone
            .Columns(2).SetWidth CentimetersToPoints(8), wdAdjustNone
            .Range.Cells.VerticalAlignment = wdAlignVerticalCenter
            .Rows.Alignment = wdAlignRowCenter
            With .Range.ParagraphFormat
                .SpaceBefore = 0
                .SpaceAfter = 0
                .LineSpacingRule = wdLineSpaceSingle
            End With
        End With
        With tbl.Rows(1)
            .Range.Font.Size = 14
            .Range.Font.Bold = True
            .Range.Font.BoldBi = True
            .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
            .Shading.BackgroundPatternColor = wdColorGray15
            .Cells(1).Range.Text = "החלף (טקסט שגוי)"
            .Cells(2).Range.Text = "ב- (טקסט מתוקן)"
        End With
        i = 1
        For Each entry In Application.AutoCorrect.Entries
            i = i + 1
            Application.StatusBar = "מייצא רשומה " & i - 1 & " מתוך " & totalEntries & "..."
            With tbl.Rows(i)
                .Range.Font.Bold = False
                .Range.Font.BoldBi = False
                .Range.Font.Size = 11
                .Range.ParagraphFormat.Alignment = wdAlignParagraphRight
                If i Mod 2 = 0 Then
                    .Shading.BackgroundPatternColor = wdColorGray05
                End If
                .Cells(1).Range.Text = entry.Name
                .Cells(2).Range.Text = entry.value
            End With
        Next entry
        Application.StatusBar = False
        Application.ScreenUpdating = True
        tbl.Select
        DoEvents
        Selection.Collapse Direction:=wdCollapseStart
        MsgBox totalEntries & " רשומות יוצאו בהצלחה לטבלה.", _
               vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "הייצוא הושלם"
    End If
End Sub

Sub תיקון_אוטומטי_ייבוא_מטבלה_איפוס()
    Dim tbl As Table
    Dim i As Long, j As Long ' הוספנו את j עבור לולאת המחיקה
    Dim totalRows As Long
    Dim mila As String, tikun As String
    Dim importedCount As Long, deletedCount As Long
    If ActiveDocument.Tables.Count = 0 Then
        MsgBox "לא נמצאה טבלה במסמך הפעיל.", _
               vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, "שגיאה: לא נמצאה טבלה"
        Exit Sub
    End If
    If MsgBox("אזהרה!" & vbCrLf & vbCrLf & _
              "פעולה זו תמחק **לחלוטין** את כל רשימת התיקונים הקיימת שלך, " & _
              "ותחליף אותה רק בערכים מהטבלה." & vbCrLf & _
              "הפעולה אינה ניתנת לביטול." & vbCrLf & vbCrLf & _
              "האם אתה בטוח שברצונך להמשיך?", _
              vbYesNo + vbCritical + vbDefaultButton2 + vbMsgBoxRight + vbMsgBoxRtlReading, _
              "אישור איפוס מלא") = vbNo Then
        Exit Sub
    End If
    Application.ScreenUpdating = False
    deletedCount = AutoCorrect.Entries.Count
    For j = deletedCount To 1 Step -1
        Application.StatusBar = "מוחק רשומה ישנה " & (deletedCount - j + 1) & " מתוך " & deletedCount & "..."
        AutoCorrect.Entries(j).Delete
    Next j
    Set tbl = ActiveDocument.Tables(1)
    totalRows = tbl.Rows.Count
    importedCount = 0
    For i = 2 To totalRows
        Application.StatusBar = "מייבא רשומה " & i - 1 & " מתוך " & totalRows - 1 & "..."
        mila = Trim(Left(tbl.Cell(i, 1).Range.Text, Len(tbl.Cell(i, 1).Range.Text) - 2))
        tikun = Trim(Left(tbl.Cell(i, 2).Range.Text, Len(tbl.Cell(i, 2).Range.Text) - 2))
        If Len(mila) > 0 And Len(tikun) > 0 Then
            On Error Resume Next
            AutoCorrect.Entries.Add Name:=mila, value:=tikun
            If Err.Number = 0 Then
                importedCount = importedCount + 1
            Else
                Err.Clear
            End If
            On Error GoTo 0
        End If
    Next i
    Application.StatusBar = False
    Application.ScreenUpdating = True
    MsgBox "התהליך הושלם בהצלחה!" & vbCrLf & vbCrLf & _
           deletedCount & " רשומות ישנות נמחקו." & vbCrLf & _
           importedCount & " רשומות חדשות יובאו מהטבלה.", _
           vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "איפוס וייבוא הושלמו"
End Sub