Microsoft Office Forums - View Single Post - [Solved] handle textbox, pictures, and all kind of shapes

macropod · 02-27-2017, 06:20 AM

Try:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, Rng As Range, StrType
With ActiveDocument
  For i = .Shapes.Count To 1 Step -1
    With .Shapes(i)
      If Not .TextFrame Is Nothing Then
        Select Case .Type
          Case msoAutoShape: StrType = "AutoShape"
          Case msoCallout: StrType = "Callout"
          Case msoCanvas: StrType = "Canvas"
          Case msoChart: StrType = "Chart"
          Case msoComment: StrType = "Comment"
          Case msoDiagram: StrType = "Diagram"
          Case msoEmbeddedOLEObject: StrType = "EmbeddedOLEObject"
          Case msoFormControl: StrType = "FormControl"
          Case msoFreeform: StrType = "Freeform"
          Case msoGroup: StrType = "Group"
          Case msoInk: StrType = "Ink"
          Case msoInkComment: StrType = "InkComment"
          Case msoLine: StrType = "Line"
          Case msoLinkedOLEObject: StrType = "LinkedOLEObject"
          Case msoLinkedPicture: StrType = "LinkedPicture"
          Case msoMedia: StrType = "Media"
          Case msoOLEControlObject: StrType = "OLEControlObject"
          Case msoPicture: StrType = "Picture"
          Case msoPlaceholder: StrType = "Placeholder"
          Case msoScriptAnchor: StrType = "ScriptAnchor"
          Case msoShapeTypeMixed: StrType = "ShapeTypeMixed"
          Case msoTable: StrType = "Table"
          Case msoTextBox: StrType = "TextBox"
          Case msoTextEffect: StrType = "TextEffect"
        End Select
        If Len(Trim(.TextFrame.TextRange.Text)) > 1 Then
          Set Rng = .Anchor
          With Rng
            .InsertBefore StrType & " start << "
            .Collapse wdCollapseEnd
            .InsertAfter " >> end " & StrType
            .Collapse wdCollapseStart
          End With
          Rng.FormattedText = .TextFrame.TextRange.FormattedText
        End If
        .Delete
      End If
    End With
  Next
  For i = .InlineShapes.Count To 1 Step -1
    With .InlineShapes(i)
      If Not .TextEffect Is Nothing Then
        If Len(Trim(.TextEffect.Text)) > 1 Then
          Select Case .Type
            Case wdInlineShapeChart: StrType = "InlineChart"
            Case wdInlineShapeDiagram: StrType = "InlineDiagram"
            Case wdInlineShapeEmbeddedOLEObject: StrType = "InlineEmbeddedOLEObject"
            Case wdInlineShapeHorizontalLine: StrType = "InlineHorizontalLine"
            Case wdInlineShapeLinkedOLEObject: StrType = "InlineLinkedOLEObject"
            Case wdInlineShapeLinkedPicture: StrType = "InlineLinkedPicture"
            Case wdInlineShapeLinkedPictureHorizontalLine: StrType = "InlineShapeLinkedPictureHorizontalLine"
            Case wdInlineShapeLockedCanvas: StrType = "InlineLockedCanvas"
            Case wdInlineShapeOLEControlObject: StrType = "InlineOLEControlObject"
            Case wdInlineShapeOWSAnchor: StrType = "InlineOWSAnchor"
            Case wdInlineShapePicture: StrType = "InlinePicture"
            Case wdInlineShapePictureBullet: StrType = "InlinePictureBullet"
            Case wdInlineShapePictureHorizontalLine: StrType = "InlinePictureHorizontalLine"
            Case msoLinkedOLEObject: StrType = "LinkedOLEObject"
            Case wdInlineShapeScriptAnchor: StrType = "InlineScriptAnchor"
          End Select
          Set Rng = .Range
          With Rng
            .Collapse wdCollapseStart
            .InsertBefore StrType & " start << "
            .Collapse wdCollapseEnd
            .InsertAfter " >> end " & StrType
            .Collapse wdCollapseStart
          End With
          Rng.Text = .TextEffect.Text
        End If
        .Delete
      End If
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

PS: You will never learn much VBA by simply having others do the coding work for you. Furthermore, I note that you have never thanked anyone here for all the help you've been given. In future, don't take the help for granted and expect to show you've made a decent effort yourself before asking for help! I, for one, am getting tired of providing help to someone who doesn't always state the problem clearly, makes no apparent effort to solve the problem for themselves and then shows no gratitude for the work done...