remove shape fill all text boxes

Gromadavo · #1 06-02-2017, 07:05 AM

Hello,
can someone help me with a macro to remove the shape fill of all text boxes in a document? Even when they are in a group.

Thank you!

Guessed · #2 06-03-2017, 08:56 PM

This should get you started

Code:

Sub EmptyShapes()
  Dim aShp As Shape, aShp2 As Shape
  For Each aShp In ActiveDocument.Shapes
    If aShp.TextFrame.HasText Then
      aShp.Fill.Visible = False
    ElseIf aShp.Type = msoGroup Then
      For Each aShp2 In aShp.GroupItems
        If aShp2.TextFrame.HasText Then
          aShp2.Fill.Visible = False
        End If
      Next aShp2
    End If
  Next aShp
End Sub

This only does one level of grouping. You may need to rewrite it to use a recursive function in case there are nested groups (ie groups of groups).

Gromadavo · #3 06-04-2017, 04:16 AM

Hey,
Thanks a lot!

i try to run it, but i get runtime error '-2147467263 (80004001)': the specified value is out of range.

the problem seems to be in the 4th line: "if a Shp.textframe.........

Do you know what the problem could be?

Thank you!

Guessed · #4 06-04-2017, 03:12 PM

There are different types of shapes which could appear in your document. I would assume your document has some shapes that don't have text frames - perhaps they are graphics imported from other programs. You will need to test for those types so you can exclude them from the recolouring. This amended code will stop the macro so you can examine the problem shape and work out what is causing the error. If you can work out what type of shapes you want the code to address/avoid then you can recode the macro to do that.

Code:

Sub EmptyShapes()
  Dim aShp As Shape, aShp2 As Shape
  On Error GoTo ErrCatcher
  For Each aShp In ActiveDocument.Shapes
    If aShp.TextFrame.HasText Then
      aShp.Fill.Visible = False
    ElseIf aShp.Type = msoGroup Then
      For Each aShp2 In aShp.GroupItems
        If aShp2.TextFrame.HasText Then
          aShp2.Fill.Visible = False
        End If
      Next aShp2
    End If
  Next aShp
  Application.ScreenRefresh
  Exit Sub
ErrCatcher:
  aShp.Select
  MsgBox "Error: " & Err.Number & "  " & Err.Description & vbCr & "Shape type: " & aShp.Type
End Sub

Also, what version of Word are you using?

Gromadavo · #5 06-05-2017, 01:20 AM

Hey, thanks again.

im using word 2016.

When I try this macro, i get the following error:

Guessed · #6 06-05-2017, 01:31 AM

Shape Type 3 is a chart so I've amended the code to avoid doing anything to them

Code:

Sub EmptyShapes2()
  Dim aShp As Shape, aShp2 As Shape
  On Error GoTo ErrCatcher
  For Each aShp In ActiveDocument.Shapes
    Select Case aShp.Type
      Case msoChart
        'do nothing
      Case msoGroup
        For Each aShp2 In aShp.GroupItems
          If aShp2.TextFrame.HasText Then
            aShp2.Fill.Visible = False
          End If
        Next aShp2
      Case Else
        If aShp.TextFrame.HasText Then
          aShp.Fill.Visible = False
        End If
    End Select
  Next aShp
  Application.ScreenRefresh
  Exit Sub
ErrCatcher:
  aShp.Select
  MsgBox "Error: " & Err.Number & "  " & Err.Description & vbCr & "Shape type: " & aShp.Type
End Sub

Gromadavo · #7 06-05-2017, 05:34 AM

works perfectly, thank you!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Fill / Animate Arc Shape	Ds7	PowerPoint	0	05-10-2016 01:53 AM
How to remove all pictures but keep text boxes	gn4619	Word VBA	2	10-22-2015 08:19 PM
Using variables to fill different boxes	snoopo71	PowerPoint	1	12-28-2014 08:43 AM
cropping a picture fill shape	Gerbutland	PowerPoint	5	04-06-2014 01:23 AM
Change accent theme color used as shape fill (not RGBs)	preetidb	PowerPoint	4	12-30-2013 03:22 PM