Author Topic: Changing the fill and line color of selected elements using VBA  (Read 23705 times)

0 Members and 1 Guest are viewing this topic.

ruben302

  • Jr. Member
  • **
  • Posts: 12
Hi everyone!

I am trying to mimick (using a macro) of applying a fill and line color on selected shapes, (see screenshot).

I have the following vba code, that allows me to change the fill and line color of a singular shape, but this does not work on a grouped shape. This also does not work with undo (ctrl+z), like applying a color does.

Sub changeColor()
Dim shp As Visio.Shape
For Each shp In ActiveWindow.Selection
shp.Cells("FillForegnd").FormulaForceU = "RGB(255, 255, 0)"
shp.Cells("FillBkgnd").FormulaForceU = "RGB(255, 255, 0)"
shp.Cells("LineColor").FormulaForceU = "RGB(255, 255, 0)"
Next
End Sub


Thanks in advance!
« Last Edit: May 12, 2021, 02:27:55 AM by ruben302 »

Surrogate

  • Hero Member
  • *****
  • Posts: 1639
    • ShapeSheet™ Knowledge Base
Re: Changing the fill and line color of selected elements using VBA
« Reply #1 on: May 12, 2021, 02:37:40 AM »
but this does not work on a grouped shape
Hi, Ruben !
You mean that this code dont works with sub-shapes into group shape ?
« Last Edit: May 12, 2021, 02:44:27 AM by Surrogate »

ruben302

  • Jr. Member
  • **
  • Posts: 12
Re: Changing the fill and line color of selected elements using VBA
« Reply #2 on: May 12, 2021, 02:45:40 AM »
but this does not work on a grouped shape
Hi, Ruben !
You mean that this code dont works with shapes into group shape ?

Hi! Yes!

Let's say i have a shape and a group of two shapes (see screenshot). I want to also change the colour of all the shapes inside the group with the macro.

Surrogate

  • Hero Member
  • *****
  • Posts: 1639
    • ShapeSheet™ Knowledge Base
Re: Changing the fill and line color of selected elements using VBA
« Reply #3 on: May 12, 2021, 02:48:07 AM »
You need add recursion: something like this
Code
Sub a()
    Dim sh As Visio.Shape
    Dim pg As Visio.Page
    Dim coll As New Collection
 
    For Each pg In ThisDocument.Pages
        For Each sh In pg.Shapes
            If sh.Shapes.Count > 0 Then
                Recursion sh.Shapes, coll
            End If
            coll.Add sh
        Next sh
    Next pg
    For Each sh In coll
        sh.CellsSRC(visSectionObject, visRowMisc, visNonPrinting).FormulaForceU = "False"
    Next sh
End Sub
Sub Recursion(ByVal shps As Visio.Shapes, coll As Collection)
    Dim sh As Visio.Shape
    For Each sh In shps
        If sh.Shapes.Count > 0 Then
            Recursion sh.Shapes, coll 'çäåñü ïðîèñõîäèò âûçîâ ñàìîé ñåáÿ
        End If
        coll.Add sh
    Next sh
End Sub
Thanks to 9rey for recursion macro :)

ruben302

  • Jr. Member
  • **
  • Posts: 12
Re: Changing the fill and line color of selected elements using VBA
« Reply #4 on: May 12, 2021, 02:59:16 AM »
Thanks! my VBA knowledge is however very limited, how would I encorporate my code into this?

Surrogate

  • Hero Member
  • *****
  • Posts: 1639
    • ShapeSheet™ Knowledge Base
Re: Changing the fill and line color of selected elements using VBA
« Reply #5 on: May 12, 2021, 03:54:13 AM »
how would I encorporate my code into this?
Sorry ! My previous code not so obvious…
Code
Sub Main()
' ** I borrowed this part of the code at http://visguy.com/vgforum/index.php?topic=1173.msg37893#msg37893
Dim vsoSelect As Visio.Selection
Dim vsoShape As Visio.Shape
Dim vsoShapes As Visio.Shapes
Set vsoSelect = Visio.ActiveWindow.Selection
If vsoSelect.Count > 0 Then
    For Each vsoShape In vsoSelect
        Call changeColor(vsoShape)
    Next vsoShape
Else
    MsgBox "You Must Have Something Selected"
End If
MsgBox "TheEnd!!!"
' **
End Sub
Public Sub changeColor(shp As Visio.Shape)
' *** I borrowed this part of the code at http://visguy.com/vgforum/index.php?topic=9558.msg42730#msg42730
shp.Cells("FillForegnd").FormulaForceU = "RGB(255, 255, 0)"
shp.Cells("FillBkgnd").FormulaForceU = "RGB(255, 255, 0)"
shp.Cells("LineColor").FormulaForceU = "RGB(255, 255, 0)"
' ***
' * I borrowed this part of the code at http://visguy.com/vgforum/index.php?topic=1173.msg37886#msg37886
Dim subshp As Visio.Shape
If shp.Shapes.Count > 0 Then
    For Each subshp In shp.Shapes
        Call changeColor(subshp)
    Next subshp
End If
End Sub
' *
to write this code, I took the snippets in these posts: #1 (wrapped in *) and #2 (wrapped in **) and add your own code (wrapped in ***)

ruben302

  • Jr. Member
  • **
  • Posts: 12
Re: Changing the fill and line color of selected elements using VBA
« Reply #6 on: May 12, 2021, 04:10:54 AM »
Wow thanks a lot! this works already!

I only have one problem still:

some shapes inside my group are GUARDed so ideally i would use:

Quote
shp.Cells("FillForegnd").FormulaU = "RGB(255, 255, 0)"
shp.Cells("FillBkgnd").FormulaU = "RGB(255, 255, 0)"
shp.Cells("LineColor").FormulaU = "RGB(255, 255, 0)"

to not overrule the GUARD, but this returns an error, see attached file (or screenshot)

Surrogate

  • Hero Member
  • *****
  • Posts: 1639
    • ShapeSheet™ Knowledge Base
Re: Changing the fill and line color of selected elements using VBA
« Reply #7 on: May 12, 2021, 04:27:32 AM »
to not overrule the GUARD, but this returns an error, see attached file (or screenshot)
when you use FormulaU and try change formula in cell which protected with GUARD you get error, because FormulaU cant change this cell !
you sure that you need try change these cells ?

ruben302

  • Jr. Member
  • **
  • Posts: 12
Re: Changing the fill and line color of selected elements using VBA
« Reply #8 on: May 12, 2021, 04:30:13 AM »
i don't want to update the GUARD protected cells, only the unprotected cells. but the script stops when it comes across the first GUARDed cell

I want the script to skip the GUARDed cells.
« Last Edit: May 12, 2021, 04:32:58 AM by ruben302 »

Surrogate

  • Hero Member
  • *****
  • Posts: 1639
    • ShapeSheet™ Knowledge Base
Re: Changing the fill and line color of selected elements using VBA
« Reply #9 on: May 12, 2021, 04:49:00 AM »
I want the script to skip the GUARDed cells.
OK, try check is formula in cell contain "GUARD" ? just change these rows
Code
If InStr(shp.Cells("LineColor").FormulaU, "GUARD") = 0 Then shp.Cells("LineColor").FormulaU = "RGB(255, 255, 0)"
If InStr(shp.Cells("FillForegnd").FormulaU, "GUARD") = 0 Then shp.Cells("FillForegnd").FormulaU = "RGB(255, 255, 0)"
If InStr(shp.Cells("FillBkgnd").FormulaU, "GUARD") = 0 Then shp.Cells("FillBkgnd").FormulaU = "RGB(255, 255, 0)"

ruben302

  • Jr. Member
  • **
  • Posts: 12
Re: Changing the fill and line color of selected elements using VBA
« Reply #10 on: May 12, 2021, 04:55:38 AM »
Thanks for your reply, however I can't get it to work, see updated attached file

edit:correct file attached

Surrogate

  • Hero Member
  • *****
  • Posts: 1639
    • ShapeSheet™ Knowledge Base
Re: Changing the fill and line color of selected elements using VBA
« Reply #11 on: May 12, 2021, 05:15:38 AM »
Sorry, I am Russian :)
You need make shape marked as Original like as shape marked as Desired ?

ruben302

  • Jr. Member
  • **
  • Posts: 12
Re: Changing the fill and line color of selected elements using VBA
« Reply #12 on: May 12, 2021, 05:18:17 AM »
Sorry, I am Russian :)
You need make shape marked as Original like as shape marked as Desired ?

No problem, I am grateful for your help! Yes you are correct. the black shape with star marked as original using VBA to the yellow shaped marked as desired.

Surrogate

  • Hero Member
  • *****
  • Posts: 1639
    • ShapeSheet™ Knowledge Base
Re: Changing the fill and line color of selected elements using VBA
« Reply #13 on: May 12, 2021, 05:20:33 AM »
My bad ! Some shapes have in their cells, this is reason why my code dont work correct  :o

Surrogate

  • Hero Member
  • *****
  • Posts: 1639
    • ShapeSheet™ Knowledge Base
Re: Changing the fill and line color of selected elements using VBA
« Reply #14 on: May 12, 2021, 05:26:36 AM »
Try this changes again ! Check is formula in cell do not started with GUARD
Code
If Not InStr(shp.Cells("LineColor").FormulaU, "GUARD") = 1 Then shp.Cells("LineColor").FormulaU = "RGB(255, 255, 0)"
If Not InStr(shp.Cells("FillForegnd").FormulaU, "GUARD") = 1 Then shp.Cells("FillForegnd").FormulaU = "RGB(255, 255, 0)"
If Not InStr(shp.Cells("FillBkgnd").FormulaU, "GUARD") = 1 Then shp.Cells("FillBkgnd").FormulaU = "RGB(255, 255, 0)"
« Last Edit: May 12, 2021, 05:33:18 AM by Surrogate »