וורד האשכול המרכזי לשאלות וטיפים בוורד

moishy · 22/6/12

נכתב ע"י Yisrael;799970:
בוורד אין אוסף מילים בהיררכיית האוספים. באמת מעצבן בהרבה מקרים, אבל אי אפשר לעבור מילה מילה כמו שאפשר לעבור תו תו ופסקה פסקה.

א"כ מה זה?

קוד:

Selection.[B]Words[/B]

moishy · 22/6/12

נכתב ע"י אלחנן אריאל;799981:
זה אפשרי, עם כי בדרכים עקיפות.
למשל, אני בוחר (ע"י חיפוש) את כל הטקסט האוטומטי, ומעצבו בקו תחתון. ולאחר מכן בוחר (ע"י חיפוש), כל אשר אינו בקו תחתון.

עד כמה שידוע לי אין אפשרות לחפש בשלילה, ומ"מ יש פתרון המודגם בקוד הבא

קוד:

Sub FindNotBlack()
    Dim rDcm As Range
    Set rDcm = ActiveDocument.Range
    With rDcm.Find
        .Text = "<*>"
        .MatchWildcards = True
        While .Execute
            If rDcm.Font.Color <>wdColorAutomatic Then
                            rDcm.Font.Color = wdColorRed
            End If
        Wend
    End With
End Sub

Yisrael · 22/6/12

נכתב ע"י אלחנן אריאל;799972:
ראשית, תודה רבה!

צירפתי תמונה של הודעת השגיאה.

ושוב תודה!
אין מילים!

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

נכתב ע"י אלחנן אריאל;799981:
זה אפשרי, עם כי בדרכים עקיפות.
למשל, אני בוחר (ע"י חיפוש) את כל הטקסט האוטומטי, ומעצבו בקו תחתון. ולאחר מכן בוחר (ע"י חיפוש), כל אשר אינו בקו תחתון.

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

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

נכתב ע"י moishy;799995:
א"כ מה זה?

קוד:

Selection.[B]Words[/B]

צודק, טעות שלי שכחתי את האופציה הזו, וצירפתי קוד משופר על פי דבריך. תודה.

קוד:

Sub העתקת__טקסט_צבוע()
Dim MyArray() As Variant
For i = 1 To ActiveDocument.Words.Count
    If Not ActiveDocument.Words(i).Font.ColorIndexBi = wdAuto Then
      start = ActiveDocument.Words(i).start
        For t = i To ActiveDocument.Words.Count
        f = f + 1
          If ActiveDocument.Words(t).Font.ColorIndexBi = wdAuto Then
            endd = ActiveDocument.Words(t).start
            Selection.SetRange start, endd
            y = y + 1
            ReDim Preserve MyArray(y)
            MyArray(y) = Selection.Range & "-" & Selection.Information(wdActiveEndPageNumber)
            i = i + f
            Exit For
            End If
        Next t
    End If
Next i

Documents.Add
  For E = 1 To y
    ActiveDocument.Paragraphs(E).Range = MyArray(E)
      If E < y Then
        Selection.EndKey wdStory
        ActiveDocument.Paragraphs.Add Selection.Range
      End If
  Next E
End Sub

נכתב ע"י moishy;800012:
עד כמה שידוע לי אין אפשרות לחפש בשלילה, ומ"מ יש פתרון המודגם בקוד הבא

קוד:

Sub FindNotBlack() Dim rDcm As Range Set rDcm = ActiveDocument.Range With rDcm.Find .Text = "<*>" .MatchWildcards = True While .Execute If rDcm.Font.Color <>wdColorAutomatic Then rDcm.Font.Color = wdColorRed End If Wend End With End Sub

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

אלחנן אריאל · 22/6/12

נכתב ע"י moishy;800012:
עד כמה שידוע לי אין אפשרות לחפש בשלילה,
[/CODE]

א"כ מה זה?

אלחנן אריאל · 22/6/12

נכתב ע"י Yisrael;800153:
על פניו זה נראה שיש לו איזה בעיה עם ההקצאה של המילה start למשתנה, אולי הוא מוקצה לאיזו פונקציה כללית או משהו כזה, תנסה לשנות את המילה למשהו אחר (בכל המופעים שלה בשגרה) ונראה מה יהיו חלומותיו.

שיניתי את המלה start, ואכן אינו נתקע!
אציין, כי לא את כל מילות start היה צריך לשנות. למשל בשורה הזו:

קוד:

 start = ActiveDocument.Words(i).start

היה צריך לשנות את אשר בפתיחת השורה, ולא את זו שבחתימתה.

נכתב ע"י Yisrael;800153:

צירפתי קוד משופר.

קוד:

Sub העתקת__טקסט_צבוע()
Dim MyArray() As Variant
For i = 1 To ActiveDocument.Words.Count
    If Not ActiveDocument.Words(i).Font.ColorIndexBi = wdAuto Then
      start = ActiveDocument.Words(i).start
        For t = i To ActiveDocument.Words.Count
        f = f + 1
          If ActiveDocument.Words(t).Font.ColorIndexBi = wdAuto Then
            endd = ActiveDocument.Words(t).start
            Selection.SetRange start, endd
            y = y + 1
            ReDim Preserve MyArray(y)
            MyArray(y) = Selection.Range & "-" & Selection.Information(wdActiveEndPageNumber)
            i = i + f
            Exit For
            End If
        Next t
    End If
Next i

Documents.Add
  For E = 1 To y
    ActiveDocument.Paragraphs(E).Range = MyArray(E)
      If E < y Then
        Selection.EndKey wdStory
        ActiveDocument.Paragraphs.Add Selection.Range
      End If
  Next E
End Sub

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

שוב יישר כחך ר' ישראל!
תודה רבה עד מאוד!

אלחנן אריאל · 22/6/12

נכתב ע"י moishy;800012:

יש פתרון המודגם בקוד הבא

קוד:

Sub FindNotBlack()
    Dim rDcm As Range
    Set rDcm = ActiveDocument.Range
    With rDcm.Find
        .Text = "<*>"
        .MatchWildcards = True
        While .Execute
            If rDcm.Font.Color <>wdColorAutomatic Then
                            rDcm.Font.Color = wdColorRed
            End If
        Wend
    End With
End Sub

לא זכיתי להבין, איזה חלק הקוד הזה אמור לפתור?
אצלי הוא לא הביאני לתכלית הנרצית.

אלחנן אריאל · 23/6/12

נכתב ע"י אלחנן אריאל;800288:
לא פעל על כל הטקסט שצבעם שונה. כי אם על כ15% מהם.
אתמהה?!

שוב יישר כחך ר' ישראל!
תודה רבה עד מאוד!

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

moishy · 24/6/12

נכתב ע"י אלחנן אריאל;800273:
א"כ מה זה?

צודק שכחתי מזה.

moishy · 24/6/12

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

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

Yisrael · 24/6/12

נכתב ע"י אלחנן אריאל;800288:
שיניתי את המלה start, ואכן אינו נתקע!
אציין, כי לא את כל מילות start היה צריך לשנות. למשל בשורה הזו:

קוד:

start = ActiveDocument.Words(i).start

היה צריך לשנות את אשר בפתיחת השורה, ולא את זו שבחתימתה.

ברור! שכחתי לציין זאת, אבל המילה start שבתחילת המילה היא משתנה שהקציתי לו שם בעלמא, כנראה שהשם הזה מוקצה אצלך למשהו אחר וזו הייתה הבעיה. מה-שאין-כן המילה start שבסוף השורה שהיא אינה המשתנה הלז כלל וכלל וצריכה להישאר כמות שהיא.

נכתב ע"י אלחנן אריאל;800291:
לא זכיתי להבין, איזה חלק הקוד הזה אמור לפתור?
אצלי הוא לא הביאני לתכלית הנרצית.

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

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

מוזר ביותר!

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

האם מדובר על המסמך שהעלית כאן? אם לא אולי תוכל לתת הורדה שלו?

בשמחה...

moishy · 25/6/12

הנה פתרון פשוט, בדוק ומנוסה.

קוד:

Sub העתקת_טקסט_צבעוני()
    Application.Documents.Add ActiveDocument.FullName
    Application.ScreenUpdating = False
    With ActiveDocument.Content
        With .Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Forward = False
            .Wrap = wdFindStop
            .Format = True
            .Text = ""
            .Font.ColorIndex = wdAuto
            .Execute
        End With
        Do While .Find.Found
            .Text = vbTab & "עמוד " & .Duplicate.Characters.First.Information(wdActiveEndPageNumber) & vbCr
            .Collapse wdCollapseStart
            .Find.Execute
        Loop
        With .Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Wrap = wdFindContinue
            .Format = False
            .MatchWildcards = True
            .Text = "^13^tעמוד [0-9]{1,2}"
            .Replacement.Text = ""
            .Execute Replace:=wdReplaceAll
        End With
        .Paragraphs.First.Range.Delete
    End With
    ActiveDocument.Range.Characters.Last.Previous.Delete
    Application.ScreenUpdating = True
End Sub

אלחנן אריאל · 25/6/12

תודה רבה לר' ישראל,
שהביא לפתרון הרצוי,
בקוד הזה:

קוד:

Sub העתקת_טקסט_צבוע()

Dim MyArray() As Variant

Selection.Find.ClearFormatting: Selection.Find.Font.ColorIndexBi = wdRed
a:
  If Selection.Find.Execute(findtext:="") Then
    y = y + 1
    ReDim Preserve MyArray(y)
    MyArray(y) = Selection.Range & " -" & Selection.Information(wdActiveEndPageNumber)
    GoTo a
  End If

Documents.Add
  For E = 1 To y
    ActiveDocument.Paragraphs(E).Range = MyArray(E)
      If E < y Then
        Selection.EndKey wdStory
        ActiveDocument.Paragraphs.Add Selection.Range
      End If
  Next E
End Sub

זה לאחר שכל המשפטים האמורים להשלף, נצבעו באדום.

moishy · 26/6/12

נכתב ע"י אלחנן אריאל;802011:
תודה רבה לר' ישראל,
שהביא לפתרון הרצוי,
בקוד הזה:

קוד:

Sub העתקת_טקסט_צבוע() Dim MyArray() As Variant Selection.Find.ClearFormatting: Selection.Find.Font.ColorIndexBi = wdRed a: If Selection.Find.Execute(findtext:="") Then y = y + 1 ReDim Preserve MyArray(y) MyArray(y) = Selection.Range & " -" & Selection.Information(wdActiveEndPageNumber) GoTo a End If Documents.Add For E = 1 To y ActiveDocument.Paragraphs(E).Range = MyArray(E) If E < y Then Selection.EndKey wdStory ActiveDocument.Paragraphs.Add Selection.Range End If Next E End Sub

זה לאחר שכל המשפטים האמורים להשלף, נצבעו באדום.

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

זאבי · 26/6/12

תודה רבה! הקוד של הדגשת מילה ראשונה בכל קטע מאוד עזר גם לי,
הבעיה היא שבמקרה שהמילה הראשונה מורכבת מראשי תיבות, זה נעצר במרכאות,
לדוגמא אם תחילת קטע הוא: תשר"ת בחירת הקוד הנ"ל מסמנת רק תשר.
האם יש דרך להתגבר על זה?

דודו10 · 26/6/12

שלום,
כן גם אני הבחנתי בבעיה הזאת

אם למישהו יש פתרון, אשמח לשמוע

ושוב תודה

eliezer · 26/6/12

נכתב ע"י דודו10;802564:
שלום,
כן גם אני הבחנתי בבעיה הזאת

אם למישהו יש פתרון, אשמח לשמוע

ושוב תודה

(^013[! ]@ )

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

לפני הרצתו בדוק שאין רווח בתחילת פסקה על ידי
(^013)( ) והחלף ב\1

Yisrael · 26/6/12

תנסה במקום הסימן "<" שבקוד הנ"ל - לשים רווח.

דודו10 · 26/6/12

שלום

בקיצור האם מישהו יוכל לכתוב לי מסודר את הדוק המדוייק שצריך לכתוב עבור הדגשה של אות ראשונה כולל מרכאות

תודה

eliezer · 26/6/12

נכתב ע"י דודו10;802623:
שלום

בקיצור האם מישהו יוכל לכתוב לי מסודר את הדוק המדוייק שצריך לכתוב עבור הדגשה של אות ראשונה כולל מרכאות

תודה

אות או מילה?
מילה כבר כתבו בשתי צורות שונות. אני מעדיף את שלי כי בטוח לא יבחר יותר ממילה אחת.

Yisrael · 26/6/12

נכתב ע"י moishy;802304:
אצלי זה פעל פחות טוב מהגירסא המקורית של ר' ישראל, רק אחוז מזערי של הצבועים באדום אכן חולצו.

מוזר!

יש לך הסבר לזה? (מעניין לראות את הקובץ בשביל להחכים)

פרוגבוט

פרסומת

וורד האשכול המרכזי לשאלות וטיפים בוורד

משתמש סופר מקצוען

משתמש סופר מקצוען

משתמש פעיל

משתמש צעיר

קבצים מצורפים

משתמש צעיר

משתמש צעיר

משתמש צעיר

משתמש סופר מקצוען

משתמש סופר מקצוען

משתמש פעיל

משתמש סופר מקצוען

משתמש צעיר

משתמש סופר מקצוען

משתמש מקצוען

משתמש רשום

מהנדס בינה מלאכותית

משתמש פעיל

משתמש רשום

מהנדס בינה מלאכותית

משתמש פעיל

פרוגבוט

תוכן שיווקי

איזה כיף שהצטרפתם לניוזלטר שלנו!