וורד - עזרה עם מאקרא לחילוץ טקסט מתיבות טקסט

[אהרן]

בפרוג העלו את המאקרא הזה
(התצוגה מסתבכת בגלל סימוני ה`)

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

הבעיה שהוא לא מבצע על כל התיבות יחד
ועיקר הבעיה שהוא בכלל לא מזהה חלק מהתיבות

מישהו יכול לעזור עם תיקון המאקרא?

[רחמים]

@אהרן על פניו המאקרו נראה די בסדר, מה אתה מצפה שהמאקרו יעשה בדיוק?

[אהרן]

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

[רחמים]

@אהרן המסמך שלך מכיל 'מסגרות' או 'תיבות טקסט'?

[אהרן]

@רחמים
לא מצליח למצוא א"ז עכשיו (הקובץ ענק)
ואם זה מסגרות
מספיק להחליף את msoTextBox? להחליף למה?

תודה!!

[רחמים]

@אהרן תנסה msoAutoShape או msoShapeRectangle