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
בהצלחה!
וואה! עובד מעולה
- המאקרו יעבור על כל הסוגריים שבקובץ, מן הסמן והלאה.
- גם ימחוק סוגריים החיצוניים, ויוסיף נקודה בסוף ההערה.
- גם ימחוק הריווח המיותר בפנים הטקסט שהיתה לפני הסוגר הראשון.
קיץ בריא :)
הגיע הזמן להיות עם מקצוע ביד!
הנה כמה קורסים שמתחילים ממש כעת:
15.05
י"ד אייר
פתיחת קורס
צילום
אפשר עדיין להצטרף
מסלול לנשים
29.05
כ"ח אייר
פתיחת קורס
copy+דיגיטל
אפשר עדיין להצטרף
29.05
כ"ח אייר
פתיחת קורס
אוטומציות
אפשר עדיין להצטרף
26.06
כ"ז סיון
פתיחת קורס
עיצוב פנים
30.06
א תמוז
פתיחת קורס
סאונד
24.07
כ"ה תמוז
פתיחת קורס
עיצוב גרפי
24.07
כ"ה תמוז
פתיחת קורס
ux/ui
382,394
משתמשים נכנסו לפרוג בחודש האחרון
194
משתמשים מבקרים ברגע זה באתר
6,372
הודעות נכתבו בממוצע ליום בחודש האחרון