אופיס 365 פקודת מאקרו

אותיות פורחות

משתמש סופר מקצוען
מוזיקה ונגינה
עריכה תורנית
יש לי ספר שבו הרבה פסוקים אותם אני צריך לנקד.
לשם כך פתחתי קובץ נוסף שבו נמצא טקסט המקור במנוקד, הקלטתי פקודת מאקרו שמוצאת את הפסוק בטקסט שלי ומעתיקה אותו ואז היא מחפשת בקובץ השני היכן נמצא אותו הפסוק, מעתיקה את המנוקד, חוזרת לקובץ שלי ומחליפה את הפסוק הלא מנוקד בפסוק המנוקד.
דא עקא, שפקודת החיפוש בקובץ השני, אינה מוגדרת כחיפוש 'תוצאת החיפוש מהקובץ הראשון', אלא הוא פשוט הקליט את החיפוש של הטקסט עצמו, מה שגורם לכך שהמחשב מחפש את הטקסט אותו הזנתי בשעת הקלטת המאקרו, למרות שהזנתי אותו על ידי תוצאת החיפוש.
והשאלה בקיצור:
יש דרך להגדיר בפקודת מאקרו שהיא תחפש את 'תוצאת החיפוש' ולא מילים ספציפיות?
מצרף את הקוד של המאקרו
תודה רבה
Attribute VB_Name = "NewMacros"

Sub Macro1()
Attribute Macro1.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.Macro1"
'
' Macro1 Macro
'
'
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
Selection.Font.Bold = wdToggle
Selection.Font.BoldBi = wdToggle
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="."
Selection.Font.Bold = wdToggle
Selection.Font.BoldBi = wdToggle
Selection.TypeText Text:=" "
End Sub
Sub Macro2()
Attribute Macro2.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.Macro2"
'
' Macro2 Macro
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
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.Copy
Windows("מסמך2").Activate
Selection.WholeStory
Selection.PasteAndFormat (wdFormatOriginalFormatting)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
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 Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
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 Replace:=wdReplaceAll
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 Replace:=wdReplaceAll
Selection.WholeStory
Selection.Copy
Windows("שמואל עבור נסיונות מאקרו").Activate
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
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.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "ויהי איש אחד מן הרמתים"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Copy
Windows("מסמך7").Activate
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "ויהי איש אחד מן הרמתים"
.Replacement.Text = "וַיְהִי אִישׁ אֶחָד מִן הָרָמָתַיִם"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With
Selection.MoveDown Unit:=wdParagraph, Count:=1
Selection.Find.ClearFormatting
Selection.Find.Font.Bold = True
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = "וַיְהִי אִישׁ אֶחָד מִן הָרָמָתַיִם"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveUp Unit:=wdParagraph, Count:=1
End Sub
 

מתמצא

משתמש פעיל
אם הבנתי אותך נכון
הפסוקים שלך מתחילים ומסתיימים בנקודה וכך אתה מוצא אותם
אם כן, מצורף בזה הקוד + תיעוד
(אגב הקוד שצירפת מלא בזבל, כנראה טעויות ונסיונות תוך כדי הקלטת המאקרו
אצלי הקוד עובד, יתכן מאוד שאצלך יהיה צריך התאמות
(שים לב להפעיל אותו מהמסך הראשון (בלי ניקוד) ושהסמן בשני המסמכים יהיה בתחילת המסמך (כי הוא מחפש קדימה)
אגב, אפשר להפעיל את הקוד הזה בלולאה עד שהוא מסיים למצוא את כל הפסוקים במסמך
קוד:
Sub Replacephrasing()
Dim file1, file2, str1, str2 As String

'שומר את שם הקובץ הנוכחי
file1 = ActiveDocument.Name

'מחפש מחרוזת המתחילה ומסתיימת בנקודה
With Selection.Find
    .Text = ".*."
    .Forward = True
    .Wrap = wdFindContinue
    .MatchWildcards = True
End With
Selection.Find.Execute

'מעתיק ומדביק על כל הבחירה
Selection.Copy
Selection.WholeStory
Selection.PasteAndFormat (wdFormatOriginalFormatting)

'מוחק את הנקודה הראשונה
    With Selection.Find
    .Text = ". "
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .MatchWildcards = True
    End With
Selection.Find.Execute Replace:=wdReplaceAll

'מוחק את מילת וגו ואת הנקודה האחרונה
    With Selection.Find
    .Text = " וגו'."
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .MatchWildcards = True
    End With
Selection.Find.Execute Replace:=wdReplaceAll
   
'מוחק נקודה
    With Selection.Find
    .Text = "."
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .MatchWildcards = True
    End With
Selection.Find.Execute Replace:=wdReplaceAll

'שומר את הפסוק שנמצא
Selection.WholeStory
str1 = Selection.Text

'פותח את המסמך המכיל את הפסוקים המנוקדים
file2 = InputBox("הכנס את שם המסמך המכיל את הפסוקים המנוקדים")
Windows(file2).Activate

'מחפש במסמך את הפסוק
Selection.Find.ClearFormatting
With Selection.Find
    .Text = str1
    .Forward = True
    .Wrap = wdFindContinue
End With
Selection.Find.Execute

'שומר את הפסוק המנוקד שנמצא
str2 = Selection.Text

'חוזר למסמך הראשון ומחליף את הפסוק הלא מנוקד במנוקד
Windows(file1).Activate
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = str1
.Replacement.Text = str2
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
 
נערך לאחרונה ב:

אותיות פורחות

משתמש סופר מקצוען
מוזיקה ונגינה
עריכה תורנית
תודה רבה @מתמצא
למען האמת לא הצלחתי להפעיל את הקוד שהבאת לי (במקום שכתבת לי הכנסתי את שם הקובץ)
הקלטתי שוב את המאקרו בלי שום פעולה מיותרת.
(יש פעולות שנראות מיותרות אך הן נחוצות להבנתי)
אם יש דרך שבה אוכל להבין את משמעות הפקודות אשמח מאוד
מצרף את המאקרו החדש וגם מתאר את התהליך שבו
Sub Macro1()
'
' Macro1 Macro
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
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.Copy
Windows("עבור תיקון הטקסט").Activate
Selection.WholeStory
Selection.PasteAndFormat (wdFormatOriginalFormatting)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
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 Replace:=wdReplaceAll
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 Replace:=wdReplaceAll
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 Replace:=wdReplaceAll
Selection.WholeStory
Selection.Copy
Windows("שמואל עבור נסיונות מאקרו").Activate
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "ויהי איש אחד"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Copy
Windows("מאקרו פרק ב").Activate
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "ויהי איש אחד"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
With Selection.Find
.Text = "ויהי איש אחד"
.Replacement.Text = "וַיְהִי אִישׁ אֶחָד"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With
End Sub

תהליך המאקרו הוא כך:
חפש טקסט שבין נקודה לנקודה עם תוים כללים
צא מחיפוש
העתק טקסט שנמצא ומעבר לקובץ אחר
בחירת הכל והדבקת הטקסט המועתק (נועד לדרוס את הטקסט שהועתק בהפעלה האחרונה של המאקרו)
חפש ''. '' כדי למחוק את הקודם לטקסט
חפש ''וגו'.'' כדי למחוק את מה שלאחר הטקסט
חפש ''.'' כדי למחוק את הנקודה האחרונה במקרים שאין את המילה וגו'.
בחירת כל הטקסט במסמך
העתקה
מעבר למסמך שמכיל את הפסוקים המנוקדים
חיפוש הטקסט שהועתק ללא תוים כללים
יציאה מחיפוש
העתקת הטקסט שנמצא
חזרה לקובץ המקורי
חיפוש הטקסט שהועתק
הדבקה בשורת ההחלפה של הטקסט המנוקד
החלפה
פתיחת החיפוש וחיפוש הטקסט המודגש הבא (זה המקום שבו יהיה הפסוק הבא)
יציאה מחיפוש
מעבר לתחילת הטקסט הנבחר.
 

אותיות פורחות

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

מתמצא

משתמש פעיל
הקוד שכתבתי מתאים לתהליך שביקשת, הוספתי גם תיעוד כדי שתבין את התהליך
אולי תנסה לדבג אותו (על ידי F8) ולעקוב היכן הוא נתקע
כדי להבין משמעות של פקודות אתה מעתיק אותם לגוגל ומחפש, תפתח את התיעוד של מיקרוסופט ותתרגם
חלק מהפקודות הם השמה למשתנים ואותם כמובן אי אפשר לתרגם, כיון שזה מוגדר על ידי המשתמש

אתה לא אמור להכניס את שם הקובץ במקום שכתבת אלא זה פותח תיבת טקסט שבה מזינים, אם אתה רוצה להפוך את זה לקבוע אתה צריך להגדיר את המשתנה (filaName) בעצמו

ולגבי שאלתך,
אי אפשר לעשות את הפקודה הזו בהקלטה, משום שאתה צריך משתנה שישמור את הטקסט המנוקד ואי אפשר להגדיר משתנים בהקלטה
 

אותיות פורחות

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

אולי מעניין אותך גם...

הפרק היומי

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


תהילים פרק קכו

א שִׁיר הַמַּעֲלוֹת בְּשׁוּב יי אֶת שִׁיבַת צִיּוֹן הָיִינוּ כְּחֹלְמִים:ב אָז יִמָּלֵא שְׂחוֹק פִּינוּ וּלְשׁוֹנֵנוּ רִנָּה אָז יֹאמְרוּ בַגּוֹיִם הִגְדִּיל יי לַעֲשׂוֹת עִם אֵלֶּה:ג הִגְדִּיל יי לַעֲשׂוֹת עִמָּנוּ הָיִינוּ שְׂמֵחִים:ד שׁוּבָה יי אֶת (שבותנו) שְׁבִיתֵנוּ כַּאֲפִיקִים בַּנֶּגֶב:ה הַזֹּרְעִים בְּדִמְעָה בְּרִנָּה יִקְצֹרוּ:ו הָלוֹךְ יֵלֵךְ וּבָכֹה נֹשֵׂא מֶשֶׁךְ הַזָּרַע בֹּא יָבוֹא בְרִנָּה נֹשֵׂא אֲלֻמֹּתָיו:
נקרא  108  פעמים

אתגר AI

תאומים • אתגר 145

לוח מודעות

למעלה