מאקרו להעתקת טקסט למסמך חדש

[sek]

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


Dim actDoc, newDoc As Document<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
Set actDoc = ActiveDocument<o></o>
Set newDoc = Documents.Add<o></o>
<o> </o>
With actDoc.Content.Find<o></o>
.ClearFormatting<o></o>
.Text = "&*&"<o></o>
.Format = False<o></o>
.MatchCase = False<o></o>
.MatchWholeWord = False<o></o>
.MatchKashida = False<o></o>
.MatchDiacritics = False<o></o>
.MatchAlefHamza = False<o></o>
.MatchControl = False<o></o>
.MatchAllWordForms = False<o></o>
.MatchSoundsLike = False<o></o>
.MatchWildcards = True<o></o>
.Execute<o></o>
Do While .Found = True<o></o>
Dim str As String<o></o>
str = actDoc.Range(.Parent.start, .Parent.End).Text<o></o>
newDoc.Content.InsertAfter (str)<o></o>
newDoc.Content.InsertParagraphAfter<o></o>
.Parent.start = .Parent.End<o></o>
.Execute

 

[שמח לעזור]

הקוד לא הכי נחמד באופן שהבאת אותו...

את השורה המסומנת תחליף באחת מהשורות הללו:

        .Font.Name = "Arial"
        .Style = "XXXX"
        .Style = wdStyleBodyText

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

(לרשימת הסגנונות המובנים, עם הקבוע המייצג אותם + השם העברי שלהם, ראו כאן: http://www.thedoctools.com/index.php?show=mt_create_style_name_list).

 

[שמח לעזור]

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

 

[sek]

תודה רבה עזרת לי מאוד