Sub RemoveTextBox2()
Dim shp As Shape
Dim oRngAnchor As Range
Dim sString As String
For Each shp In ActiveDocument.Shapes
If shp.Type = msoTextBox Then
' copy text to string, without last paragraph mark
sString = Left(shp.TextFrame.TextRange.Text, _
shp.TextFrame.TextRange.Characters.Count - 1)
If Len(sString) > 0 Then
' set the range to insert the text
Set oRngAnchor = shp.Anchor.Paragraphs(1).Range
' insert the textbox text before the range object
oRngAnchor.InsertBefore _
"Textbox start << " & sString & " >> Textbox end"
End If
shp.delete
End If
Next shp
End Sub
לחצו על קונטרול + A והדביקו לתוך פנקס רשימות במחשב. ומשום חזרה לקובץ הוורד הישן / החדש.נכתב ע"י bdtbdt;1936203:יש לי מסמך בוורד ובו תיבות טקסט רבות. אני צריכה להעתיק את המלל כך שיצא מתוך התיבות ויהפוך למלל רציף. יש דרך קצרה לעשות את זה? העתקה של כל תיבה ותיבה באופן ידני תיקח לי שעות!
תודה לכל המסייעים!
Sub RemoveTextBoxRevised()
Dim shp As Shape
Dim oRngAnchor As Range
Dim sString As String
Dim lCounter As Long
Dim i As Long
For Each shp In ActiveDocument.Shapes
If shp.Type = msoTextBox Then
lCounter = lCounter + 1
End If
Next
For i = lCounter To 1 Step -1
With ActiveDocument.Shapes(i)
If .Type = msoTextBox Then
sString = Left(.TextFrame.TextRange.Text, .TextFrame.TextRange.Characters.Count - 1)
If Len(sString) > 0 Then
Set oRngAnchor = .Anchor.Paragraphs(1).Range
oRngAnchor.InsertBefore sString
.Delete
End If
End If
End With
Next
End Sub
ניסיתי ולא עבד, משהו יכול לעזור בענין?הודות להערתו של צמרא, ניסיתי את הקוד וראיתי שבאמת יש בו בעיות משמעותיות. הנה גירסה משופרת ובדוקה.
קוד:Sub RemoveTextBoxRevised() Dim shp As Shape Dim oRngAnchor As Range Dim sString As String Dim lCounter As Long Dim i As Long For Each shp In ActiveDocument.Shapes If shp.Type = msoTextBox Then lCounter = lCounter + 1 End If Next For i = lCounter To 1 Step -1 With ActiveDocument.Shapes(i) If .Type = msoTextBox Then sString = Left(.TextFrame.TextRange.Text, .TextFrame.TextRange.Characters.Count - 1) If Len(sString) > 0 Then Set oRngAnchor = .Anchor.Paragraphs(1).Range oRngAnchor.InsertBefore sString .Delete End If End If End With Next End Sub
בנוגע לשימוש במאקרו ראו כאן https://support.office.com/he-il/article/כתיבה-או-הקלטה-של-מאקרו-cd56fb86-d8b2-475c-ba39-9728389feeeb?ui=he-IL&rs=he-IL&ad=IL
איזה גירסה של אופיס?ניסיתי ולא עבד, משהו יכול לעזור בענין?
2016איזה גירסה של אופיס?
בדקתי הרגע, עבד נפלא.2016
הצדק עם מר.בדקתי הרגע, עבד נפלא.
ניתן לעשות זאת בקלות, על בסיס המאקרו הנ"ל אך מכיון שזה נושא שונה, יש לפתוח עבורו אשכול חדש.אני חשבתי שהמאקרו נותן להעתיק את כל הטקסט בבת אחת (אני צריך להוציא אותו לקובץ אחר), והפעולה שהמאקרו עושה, זה רק להוציא את הטקסט החוצה מהתיבות..
מצאתי מאקרו במקום אחר אבל הוא לא עובד.
אל תחמיצו!!!
מנוי פרימיום באתר פרוג, יקפיץ את המוניטין שלך לקהל גדול שאסור לך להחמיץ!
ועכשיו בהזדמנות, מבצע פסח 10% הנחה ברכישת מנוי שנתי!
לוח לימודים
מסלולי לימוד שאפשר לההצטרף
אליהם ממש עכשיו:
2.04
כ"ג אדר ב'
השקה חגיגית
חדש בפרוג
קורס חדשנות AI ובינה מלאכותית
14 שיעורים מפוצצים תוכן על כלי הAI השונים ליצירת תמונות וויז'ואל, עריכת וידאו ומושן, כתיבה ורעיונות, אפיון ועיצוב אתרים ועוד המון!
ההרשמה נפתחה!
20.03
י' אדר ב'
פתיחת מסלול
עיצוב ואדריכלות פנים
מלגות גבוהות!
26.03
טז' אדר ב'
פתיחת מסלול
מאסטר בשיווק דיגיטלי
מלגות גבוהות!
8.05
ל' ניסן
פתיחת מסלול
אוטומציות עסקיות, בוטים והטמעת מערכות מידע
מלגות גבוהות!
9.05
א' אייר
ירושלמי?
יש לנו מלגה מטורפת עבורך! קורס במימון כמעט מלא!!
אוטומציות עסקיות, בוטים והטמעת מערכות מידע
ההרשמה בעיצומה
28.05
כ' אייר
פתיחת מסלול מורחב:
פיתוח ובניית אתרים
מלגות גבוהות!
תהילים פרק קכב
א שִׁיר הַמַּעֲלוֹת לְדָוִד שָׂמַחְתִּי בְּאֹמְרִים לִי בֵּית יְהוָה נֵלֵךְ:ב עֹמְדוֹת הָיוּ רַגְלֵינוּ בִּשְׁעָרַיִךְ יְרוּשָׁלִָם:ג יְרוּשָׁלִַם הַבְּנוּיָה כְּעִיר שֶׁחֻבְּרָה לָּהּ יַחְדָּו:ד שֶׁשָּׁם עָלוּ שְׁבָטִים שִׁבְטֵי יָהּ עֵדוּת לְיִשְׂרָאֵל לְהֹדוֹת לְשֵׁם יְהוָה:ה כִּי שָׁמָּה יָשְׁבוּ כִסְאוֹת לְמִשְׁפָּט כִּסְאוֹת לְבֵית דָּוִיד:ו שַׁאֲלוּ שְׁלוֹם יְרוּשָׁלִָם יִשְׁלָיוּ אֹהֲבָיִךְ:ז יְהִי שָׁלוֹם בְּחֵילֵךְ שַׁלְוָה בְּאַרְמְנוֹתָיִךְ:ח לְמַעַן אַחַי וְרֵעָי אֲדַבְּרָה נָּא שָׁלוֹם בָּךְ:ט לְמַעַן בֵּית יְהוָה אֱלֹהֵינוּ אֲבַקְשָׁה טוֹב לָךְ: