לכל מאן דבעי (וגם - תרומה לעימודית) @es0583292679
להלן המקרו לפני ואחרי השוואת המסמכים
Sub מחיקתניקוד()
'
' לסוגרייםהפיכתניקוד Macro
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "[^0192-^0204^0209^0204]"
.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 Replace:=wdReplaceAll
End Sub
Sub סוגרייםלהערות()
Application.Run MacroName:="מחיקתניקוד"
' חזרהלראשהמסמך Macro
'
'
Selection.WholeStory
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Application.ScreenUpdating = False
again:
Selection.Find.ClearFormatting
If Selection.Find.Execute(findText:="\{*\}", MatchWildcards:=True, Wrap:=wdFindStop) = True Then
strt = 2: lent = Len(Selection.Text)
re:
For I = strt To lent
If Mid(Selection.Text, I, 1) = Chr(123) Then
Selection.Extend Character:=Chr(125)
strt = I + 1: lent = Len(Selection.Text)
GoTo re
End If
Next
mRange = Right(Selection.Text, (Len(Selection.Text) - 1))
Selection.Delete
ActiveDocument.Footnotes.Add Range:=Selection.Range, Reference:="", Text:=Left(mRange, (Len(mRange) - 1))
If Selection.Previous.Text = " " Then Selection.Delete Unit:=wdCharacter, Count:=-1
GoTo again
End If
Application.ScreenUpdating = True
End Sub
Sub החזרהפנימה()
Dim Adjust As Boolean, myRange As Range
Dim I As Integer, X As Integer
Application.ScreenUpdating = False
Adjust = Options.PasteAdjustWordSpacing: Options.PasteAdjustWordSpacing = False
X = ActiveDocument.Footnotes.Count
For I = 1 To X
StatusBar = I & ":" & X
Set myRange = ActiveDocument.Footnotes(1).Range
With myRange
If InStr(myRange, Chr(13)) > 0 Then _
.Find.Execute findText:=Chr(13), ReplaceWith:=Chr(9), _
Wrap:=wdFindStop, Replace:=wdReplaceAll
.MoveStart Count:=-1: If .Characters(1) = Chr(2) Then .MoveStart Count:=1
.MoveStart Count:=Len(myRange) - Len(LTrim(myRange))
.MoveEnd Count:=Len(RTrim(myRange)) - Len(myRange)
.Copy
restoredText = Trim(myRange.Text) ' הסרת רווחים בתחילת וסוף
restoredText = Replace(restoredText, " ", "") ' הסרת כל הרווחים
End With
With ActiveDocument.Footnotes(1).Reference
.Paste: .InsertBefore "": .InsertAfter ""
If .Characters.Count >= 2 Then
Set DupFont1 = .Characters(2).Font.Duplicate
Else
' אפשר להוסיף קוד כאן אם אין מספיק תווים
Set DupFont1 = .Characters(1).Font.Duplicate ' או פשוט קח אותו
End If
If .Characters.Count > 0 Then
Set DupFont2 = .Characters.Last.Font.Duplicate
Else
' אפשר להוסיף קוד כאן אם אין תווים
End If
.Characters.Last.Font = DupFont1: .Characters.First.Font = DupFont2
.MoveStart Count:=1: .Font.SizeBi = 8
End With
Next I
Application.ScreenUpdating = True: Options.PasteAdjustWordSpacing = Adjust
End Sub
הוראות:
לפני ההשוואה להפעיל את המקרו סוגרייםלהערות
אחרי המקרו להפעיל את המקרו החזרהפנימה
מגבלות: עובד רק עם טקסט בלי הערות שוליים כמובן. עובד רק על טקסט בלי סימוני {} (אפשר להתגבר על זה אם מישהו ירצה). יתכן שעובד רק על טקסט קטן. יתכן שטקסט גדול יצטרך תוכנה חזקה יותר ממקרו פשוט.
באגים: נראה שהתנוחה של הניקוד לאחר ההחלפה לא יושבת טוב אלא זזה קצת הצידה, מי שיודע למה אשמח אם יוכל לספק הסבר.
![חיפוש גוגל בפורום](javascript:{bootbox.prompt({title:'<div style="text-align: center;"><img src="/assets/uploads/files/1625950269825-mt-google.png" width="400"></div>',placeholder:'כתוב מילים לחיפוש ב Google',buttons:{confirm:{label:'חיפוש'},cancel:{label:'ביטול'}},backdrop:true,callback:function(result){if(result!=null&&result!=''){var a=document.createElement('a');a.href='https://www.google.co.il/search?q=site:mitmachim.top '+encodeURIComponent(result.trim());a.target='_blank';a.click();}}})();};){kind=link}