דחוף ! העברת עשרות הערות שוליים אל תוך הקובץ באופן אוטומטי, אפשרי ??

[ymy8... gmail.c - ארכיון]

תאריך ההודעה המקורית: 06/06/2024 11:32

אכן כן, אתה רוצה את כל ההערות שוליים שבמסמך להעביר לתוך הקובץ ושיהיו בתוך
סוגריים? - יש מאקרו יעודי לזה.
בברכה מרובה.
יוסף מיכאל יוסקוביץ
0548496207
מעוניינים במבוא לספר? ביוגרפיה לחיבור כלשהו?* תולדות לסבא שלכם?** - ב"ה
בעל ניסיון בכתיבת מאות מבואות תולדות והקדמות לספרים שונים, עורך ספרי
היסטוריה וספרים נוספים.*
אוצרות התורה כעת במבצע - קנה את התוכנה כעת, קבל את חבילת 'מתוק מדבש' חינם,
פרטים אצלי.
ב-יום רביעי, 5 ביוני 2024 בשעה 20:18:58 UTC+3, עריכה תורנית כתב/ה:

[עריכה תורנית - ארכיון-3]

תאריך ההודעה המקורית: 07/06/2024 15:26

ישר כח!
מהו המאקרו היחודי לזה ?

מאת: מבואות ותולדות

[ymy8... gmail.c - ארכיון]

תאריך ההודעה המקורית: 07/06/2024 15:28

Sub FootnotesToMain()
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
End With
With ActiveDocument.Footnotes(1).Reference
.Paste: .InsertBefore " (": .InsertAfter ")"
Set DupFont1 = .Characters(2).Font.Duplicate
Set DupFont2 = .Characters.Last.Font.Duplicate
.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
בברכה מרובה.
יוסף מיכאל יוסקוביץ
0548496207
מעוניינים במבוא לספר? ביוגרפיה לחיבור כלשהו?* תולדות לסבא שלכם?** - ב"ה
בעל ניסיון בכתיבת מאות מבואות תולדות והקדמות לספרים שונים, עורך ספרי
היסטוריה וספרים נוספים.*
אוצרות התורה כעת במבצע - קנה את התוכנה כעת, קבל את חבילת 'מתוק מדבש' חינם,
פרטים אצלי.

[מהדיר ספרים - ארכיון]

תאריך ההודעה המקורית: 07/06/2024 15:39

יישר כח!

מאת: [email protected]

--

[חנן - ארכיון]

תאריך ההודעה המקורית: 07/06/2024 15:45

עובד נפלא,
תודה רבה!

מאת: [email protected]

[מעשה הכתב - ארכיון]

תאריך ההודעה המקורית: 07/06/2024 15:48

יישר כח עצום לרב יוסקוביץ'!

[ymy8... gmail.c - ארכיון]

תאריך ההודעה המקורית: 07/06/2024 15:55

אם כבר, קבלו מאקרו הפוך - להמיר את כל הסוגריים להערות שוליים:
Sub המרת_סוגריים_להערת_שוליים()
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(40) Then
Selection.Extend Character:=Chr(41)
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
Selection.Move
GoTo again
End If
Application.ScreenUpdating = True
End Sub
בברכה מרובה.
יוסף מיכאל יוסקוביץ
0548496207
מעוניינים במבוא לספר? ביוגרפיה לחיבור כלשהו?* תולדות לסבא שלכם?** - ב"ה
בעל ניסיון בכתיבת מאות מבואות תולדות והקדמות לספרים שונים, עורך ספרי
היסטוריה וספרים נוספים.
אוצרות התורה כעת במבצע - קנה את התוכנה כעת, קבל את חבילת 'מתוק מדבש' חינם,
פרטים אצלי.

[מעשה הכתב - ארכיון]

תאריך ההודעה המקורית: 07/06/2024 16:07

יישר כח מועיל מאוד!
שבת שלום.

מאת: [email protected]

[מהדיר ספרים - ארכיון]

תאריך ההודעה המקורית: 07/06/2024 16:39

רב תודות

--