Consulting

Results 1 to 10 of 10

Thread: How to delete color information from shape

  1. #1
    VBAX Contributor
    Joined
    Apr 2015
    Location
    Germany
    Posts
    167
    Location

    How to delete color information from shape

    Hello,

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

    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

    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.

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    I'm not sure that there's any way to get rid of the color information.

    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?
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    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
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  4. #4
    VBAX Contributor
    Joined
    Apr 2015
    Location
    Germany
    Posts
    167
    Location
    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!
    Attached Files Attached Files

  5. #5
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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

    Capture.JPG


    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


    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

    Sub RemoveFills()    Dim oShape As Shape
        
        For Each oShape In ActivePresentation.Slides(1).Shapes
            oShape.Fill.Visible = msoFalse
        Next
    
    
    End Sub
    Attached Files Attached Files
    Last edited by Paul_Hossler; 03-28-2022 at 05:35 PM.
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  6. #6
    VBAX Contributor
    Joined
    Apr 2015
    Location
    Germany
    Posts
    167
    Location
    This is awesome, Paul, thank you so much!

  7. #7
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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)
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  8. #8
    VBAX Contributor
    Joined
    Apr 2015
    Location
    Germany
    Posts
    167
    Location
    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!

  9. #9
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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



    Dim Ary(1 to 1000) as long
    dim cntAry as long
    
    cntAry = 0
    
    ...
    ...
    ...
    ...
    
    cntAry = cntAry + 1
    Ary(cntArt) = 12345
    
    ...
    ...
    ...
    
    LastVal = Ary(cntAry)
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  10. #10
    VBAX Contributor
    Joined
    Apr 2015
    Location
    Germany
    Posts
    167
    Location
    Wow, cool. I'm curious, if I'll get better in using arrays with this. Thank you so much, Paul!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •