How to delete color information from shape

Hello,

I have written a macro to get rid of fill colors very quickly, working with

Code:

---

oshp.Fill.Visible = msoFalse

---

But this is not the same as clicking "no fill" in the coloring menu. With "no fill" in the coloring menu, one really deletes the color information, while it is still there, when I use "Visible = false"

How can I really get rid of the color information? I tried

Code:

---

oshp.Fill.ForeColor.RGB = msoFalse

---

but that's just a black shape, setting RGB to 0, 0, 0.

Intention is to get completely rid of the coloring information, because I have a different macro, searching for shapes with the same color as a selected shape. It works well with one exception: It selects shapes with invisible fills of the same color, too.

It is probably just one line, but I have no idea yet.

I'm not sure that there's any way to get rid of the color information.

Quote:

---

Intention is to get completely rid of the coloring information, because I have a different macro, searching for shapes with the same color as a selected shape. It works well with one exception: It selects shapes with invisible fills of the same color, too

---

Could you add a test to see if it's visible?

AFAIK there is no way in vba to set the XML for a shape to noFill.

Could you maybe set to a weird fill like RGB(1,1,1) and set the fill to not visible

To make the problem visible, please see the attached file. I inserted both macros and put a few shapes onto the slide. The problem shape is Shape 2. It should match with Shape 1, as it seems to have no fill, but it matches with Shape 3, 4 and 5, as in fact it has an (invisible) blue fill.

John's idea with changing RGB (1,1,1) and then making this invisible would solve one half of the problem: Shape 2 would not match any longer with Shape 3, 4 and 5. But it still would not match with Shape 1. Shape 1 really has no fill. I deleted the fill of Shape 1 by using No Fill from the coloring menu, not by using the no-fill-macro.

I was hoping for something like, e.g., oshp.Fill.ForeColor.Delete (which is not the solution)

Thank you!

I think the issue was a logic error in the code

I changed to an array since it's easier to track

Not .Fill.Visible seems to work

Even with the macro that was working I kept getting an extra shape selected (possibly caused by using a collection??) - Look at Shape 2

Attachment 29560


This is a little wordy, but I like to be very specific defining If/Then tests and not try to squeeze it into a single logical statement with lots or ANDs and ORs

Code:

---

Option Explicit


Sub SelectByColor()
    Dim shpSelected As Shape
    Dim shp As Shape
    Dim aryShapes() As Long
    Dim i As Long
 
    If ActiveWindow.Selection.Type <> ppSelectionShapes And ActiveWindow.Selection.Type <> ppSelectionText Then
        MsgBox "Please select a shape"
        Exit Sub
    End If
   
    If ActiveWindow.Selection.ShapeRange.Count > 1 Then
        MsgBox "Please select only one shape"
        Exit Sub
    End If


    Set shpSelected = ActiveWindow.Selection.ShapeRange(1)


    If shpSelected.Type = msoPicture Or shpSelected.AutoShapeType = msoShapeMixed Then
        MsgBox "Sorry! For pictures and lines or connectors no fill color is defined"
        Exit Sub
    End If


    ReDim aryShapes(0 To 0)
       
    For i = 1 To ActiveWindow.Selection.SlideRange.Shapes.Count
        Set shp = ActiveWindow.Selection.SlideRange.Shapes(i)
       
        With shp
           
            If .Type = msoPicture Then GoTo NextShape
            If Not .Visible Then GoTo NextShape
            If Not .Fill.Visible And shpSelected.Fill.Visible Then GoTo NextShape
            If .Fill.Visible And Not shpSelected.Fill.Visible Then GoTo NextShape
           
            If Not .Fill.Visible And Not shpSelected.Fill.Visible Then
                aryShapes(UBound(aryShapes)) = i
                ReDim Preserve aryShapes(0 To UBound(aryShapes) + 1)
                GoTo NextShape
            End If
           
            If .Fill.ForeColor = shpSelected.Fill.ForeColor Then
                aryShapes(UBound(aryShapes)) = i
                ReDim Preserve aryShapes(0 To UBound(aryShapes) + 1)
                GoTo NextShape
            End If
        End With
NextShape:
    Next i


    If UBound(aryShapes) = 0 Then
        MsgBox "No matching shape found"
    Else
        ReDim Preserve aryShapes(0 To UBound(aryShapes) - 1)
        ActiveWindow.Selection.Unselect
        ActiveWindow.Selection.SlideRange(1).Shapes.Range(aryShapes).Select
    End If
   
End Sub

---

To remove all fills

Code:

---

Sub RemoveFills()    Dim oShape As Shape
   
    For Each oShape In ActivePresentation.Slides(1).Shapes
        oShape.Fill.Visible = msoFalse
    Next


End Sub

---

This is awesome, Paul, thank you so much!

I hope it works for you

Personal opinion: I've found that using arrays instead of collections gives me a little more control (or at least fewer opportunities to make errors)

I don't have a lot of confidence when I code with arrays or collections, because I'm not good with it. It's a lot of trial and error, so I'm always relieved when I find a solution by myself (which does not happen everytime) that works halfway. This was the case, but of course your solution is a great improvement, because now it works far better than only halfway. ;-)
I have a second version of the tool selecting by shape type, and it was easy to adapt your array solution to that one.

Again: Thank you very much!

snb has a nice writeup on arrays

https://www.snb-vba.eu/VBA_Arrays_en.html

As an aside, it the PP macro I used Redim Preserve on the dynamic array which just 'adjusts' the array size so that it could be passed to Range(..)

Depending on how it will be used, I also sometimes will Dim a fixed array and use a counter

Code:

---


Dim Ary(1 to 1000) as long
dim cntAry as long

cntAry = 0

...
...
...
...

cntAry = cntAry + 1
Ary(cntArt) = 12345

...
...
...

LastVal = Ary(cntAry)

---

Wow, cool. I'm curious, if I'll get better in using arrays with this. Thank you so much, Paul!