שיתוף | סרטון הדגמה לשימוש במאקרו לטיפול בOCR

[975]

@MOSHES
מיוחד במינו

[WD40]

@MOSHES הקובץ חסום בנטפרי תוכל להעלות בקובץ RAR?

[MOSHES]

@975 אכן מהתוספים הנ"ל למדתי על נפלאות המאקרו, וכמו שכתבת המטרה שלי היתה להמחיש....
מספיק מעט מאד של הבנה ולמידה [רק לדעת מה לבקש מבינוש...]

[MOSHES]

@WD40 בבקשה מצורף בראר - סיסמה 1234
ocr.rar

[u88]

@MOSHES אפשר לקבל את המידע מה הפקודות מכילות
או אותם בעצמם?

[דאנציג]

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

[MOSHES]

@u88 דאנציג
בבקשה
שים לב שבחלק מהמאקרואים השתמשתי בהתחכמות של החלת סגנונות, ותן לחכם ויחכם עוד
המאקרו הראשון שהשתמשתי (בערך ב1:20 בסרטון)
Module9.bas
המאקרו השני שהשתמשתי (בערך 1:51 בסרטון)
Module8.bas
היחודיות במאקרו הזה, שהוא לא רק מחבר את השורות [מוחק את האנטרים] אלא הוא משתדל שלא למחוק ריוח בין פסקאות.
המאקרו השלישי שהשתמשתי (בערך 2.01) בסרטון
Module10.bas
זה המאקרו שהופך את ההערות להערות שוליים בוורד. הרעיון שלו עובד רק כשהמספרים שבטקסט העליון הם בכתב עילי והמספרים של ההערות [שאנו רוצים שיהיו הערות שוליים] הם מספרים רגילים. והפקודה מזהה מספר עילי כמיקום הערת שוליים שהטקסט שלה מתחיל באותו מספר בכתב לא עילי.
כדי להפוך את המספרים שבטקסט העליון למספרים עיליים (במידה והם לא כאלו) אפשר להשתמש בפקודת החלפה פשוטה בוורד: חפש את ^# (זה קוד לספרה כל שהיא) החלף ב ^& (הטקסט בתיבה חפש את) ובעיצוב - גופן - כתב עילי. במידה והמספרים שבהערות שוליים הם גם מספרים עיליים, פשוט בחר את כל הטקסט ועצב ככתב לא עילי.
אם צריך עוד עזרה\ הדרכה\ וכדו', אני כאן...

[u88]

@MOSHES
תודה על הנדיבות לב אני בעזה"י אראה יותר מדיוק איך להשתמש בהם
יישר כח

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

Sub LinkNumbersForce()
    Dim doc As Document
    Dim dict As Object
    Dim regEx As Object, matches As Object, m As Object
    Dim numStr As String
    Dim pairsCount As Integer
    
    Set doc = ActiveDocument
    Set dict = CreateObject("Scripting.Dictionary")
    Set regEx = CreateObject("VBScript.RegExp")
    
    pairsCount = 0
    regEx.Global = True
    regEx.Pattern = "\d+"
    
    ' שלב 1: איסוף מספרים
    Set matches = regEx.Execute(doc.Content.Text)
    For Each m In matches
        numStr = m.Value
        If dict.Exists(numStr) Then
            dict(numStr) = dict(numStr) + 1
        Else
            dict.Add numStr, 1
        End If
    Next m
    
    ' שלב 2: ביצוע הקישור
    For Each Key In dict.Keys
        If dict(Key) = 2 Then
            Dim rng As Range
            Set rng = doc.Content
            
            With rng.Find
                .ClearFormatting
                .Text = Key
                .MatchWildcards = False
                .Forward = True
                
                If .Execute Then
                    Dim firstOccurrence As Range
                    Set firstOccurrence = rng.Duplicate
                    
                    Dim secondRng As Range
                    Set secondRng = doc.Range(rng.End, doc.Content.End)
                    
                    With secondRng.Find
                        .Text = Key
                        If .Execute Then
                            Dim noteParagraph As Range
                            Set noteParagraph = secondRng.Paragraphs(1).Range
                            
                            Dim noteText As String
                            noteText = Trim(Replace(noteParagraph.Text, Key, "", 1, 1))
                            
                            ' יצירת ההערה
                            Dim fn As Footnote
                            Set fn = doc.Footnotes.Add(Range:=firstOccurrence, Text:=noteText)
                            fn.Reference.HighlightColorIndex = wdYellow
                            
                            ' מחיקה
                            noteParagraph.Delete
                            firstOccurrence.Delete
                            
                            pairsCount = pairsCount + 1
                        End If
                    End With
                End If
            End With
        End If
    Next Key
    
    MsgBox "הסתיים! נמצאו וקושרו " & pairsCount & " זוגות של מספרים."
End Sub

[MOSHES]

@u88 חמוד מאד.

אבל צריך עוד הרבה שיפוץ - למשל:
לא מתמודד עם מספרים כפולים, תראה מה קורה כשיש גם הערה 1 ואח"כ גם הערה 11....

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

אבל הכיוון טוב, פשוט צריך קצת לשפץ ולהתאים לכל אחד לצרכו.

[u88]

@MOSHES אבקש מהחבר שישאל את הג'ימיני בנושא