Sub Macro2()
'
' Macro2 Macro
'
'
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Do
With Selection.Find
.Text = "\(*\)"
.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
Selection.Cut
With Selection
With .FootnoteOptions
.Location = wdBottomOfPage
.NumberingRule = wdRestartContinuous
.StartingNumber = 1
.NumberStyle = wdNoteNumberStyleArabic
End With
.Footnotes.Add Range:=Selection.Range, Reference:=""
End With
Selection.PasteAndFormat (wdPasteDefault)
Selection.HomeKey Unit:=wdStory
Loop
End Sub
Sub ParenthesisToFootnote()
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
GoTo again
End If
Application.ScreenUpdating = True
End Sub
נכתב ע"י קרש;492865:מאקרו להוריד כל הסוגריים שבקובץ (כולל סוגריים בתוך סוגריים) להערות שוליים.
- המאקרו יעבור על כל הסוגריים שבקובץ, מן הסמן והלאה.
- גם ימחוק סוגריים החיצוניים, ויוסיף נקודה בסוף ההערה.
- גם ימחוק הריווח המיותר בפנים הטקסט שהיתה לפני הסוגר הראשון.
יש לציין שכל המאפיינים של טקסט הסוגריים (הדגשות וכדו') נאבדים.
קוד:Sub ParenthesisToFootnote() 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 GoTo again End If Application.ScreenUpdating = True End Sub
בהצלחה!
מישהו יכול להסביר איך משתמשים בקוד הזה?קוד:Sub ParenthesisToFootnote() 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 GoTo again End If Application.ScreenUpdating = True End Sub
בהצלחה!
וואה! עובד מעולה
- המאקרו יעבור על כל הסוגריים שבקובץ, מן הסמן והלאה.
- גם ימחוק סוגריים החיצוניים, ויוסיף נקודה בסוף ההערה.
- גם ימחוק הריווח המיותר בפנים הטקסט שהיתה לפני הסוגר הראשון.
לוח לימודים
מסלולי לימוד שאפשר לההצטרף
אליהם ממש עכשיו:
2.04
כ"ג אדר ב'
השקה חגיגית
חדש בפרוג
קורס חדשנות AI ובינה מלאכותית
14 שיעורים מפוצצים תוכן על כלי הAI השונים ליצירת תמונות וויז'ואל, עריכת וידאו ומושן, כתיבה ורעיונות, אפיון ועיצוב אתרים ועוד המון!
ההרשמה נפתחה!
20.03
י' אדר ב'
פתיחת מסלול
עיצוב ואדריכלות פנים
מלגות גבוהות!
26.03
טז' אדר ב'
פתיחת מסלול
מאסטר בשיווק דיגיטלי
מלגות גבוהות!
8.05
ל' ניסן
פתיחת מסלול
אוטומציות עסקיות, בוטים והטמעת מערכות מידע
מלגות גבוהות!
9.05
א' אייר
ירושלמי?
יש לנו מלגה מטורפת עבורך! קורס במימון כמעט מלא!!
אוטומציות עסקיות, בוטים והטמעת מערכות מידע
ההרשמה בעיצומה
28.05
כ' אייר
פתיחת מסלול מורחב:
פיתוח ובניית אתרים
מלגות גבוהות!
תהילים פרק קיט א'
א אַשְׁרֵי תְמִימֵי דָרֶךְ הַהֹלְכִים בְּתוֹרַת יְהוָה:ב אַשְׁרֵי נֹצְרֵי עֵדֹתָיו בְּכָל לֵב יִדְרְשׁוּהוּ:ג אַף לֹא פָעֲלוּ עַוְלָה בִּדְרָכָיו הָלָכוּ:ד אַתָּה צִוִּיתָה פִקֻּדֶיךָ לִשְׁמֹר מְאֹד:ה אַחֲלַי יִכֹּנוּ דְרָכָי לִשְׁמֹר חֻקֶּיךָ:ו אָז לֹא אֵבוֹשׁ בְּהַבִּיטִי אֶל כָּל מִצְוֹתֶיךָ:ז אוֹדְךָ בְּיֹשֶׁר לֵבָב בְּלָמְדִי מִשְׁפְּטֵי צִדְקֶךָ:ח אֶת חֻקֶּיךָ אֶשְׁמֹר אַל תַּעַזְבֵנִי עַד מְאֹד: