VBA to change the color of a shape if it has a specific angle

[SB.visguy]

Hi guys,

I work in drawing things on Visio, but the thing is that sometimes the shapes will have a small angle that can't be seen in naked eye, but looks wrong when printed.
That's why, I want to create a macro that checks the angle of each shape, if any of these conditions are true, then change the color of the object (so i can see it).
Conditions:
1 deg> Angle of shape >0 deg
90 deg> Angle of shape > 89 deg
91 deg> Angle of shape > 90 deg
180 deg> Angle of shape > 179 deg
-1 deg < Angle of shape <0 deg
-90 deg< Angle of shape < -89 deg
-91 deg < Angle of shape < -90 deg
-180 deg > Angle of shape < -179 deg

Change the color of the shape to red if any of the above conditions are true.

Thank you, this will help me alot.

[Surrogate]

Why so many conditions? You sure that you need use vba?

[wapperdude]

Here's quick and dirty code for 1 or your conditions.  Use as example.  Add addition IF  statements for each condition.

This was for changing line color.  Change cell name it you want to change fill color.

Code Select Expand


Sub badAng()
    Dim vShp As Visio.Shape
    Dim sAng As Double
       
    For Each vShp In ActivePage.Shapes
        sAng = vShp.Cells("Angle").Result(visDegrees)
        If (Abs(sAng) <> 0 And Abs(sAng) < 1) Then vShp.Cells("LineColor").Formula = "RGB(255,0,0)"
    Next
End Sub


[SB.visguy]

Thank you alot wapperdud! This is exactly what i want. You made my day!

[Surrogate]

IMHO: Not sure that it is best way use VBA, because you need manually start your macro or add trigger for start it.

My alternative ShapeSheet long formula in LineColor cell

Code Select Expand

IF(OR(AND(Angle<1 deg,Angle>0 deg),AND(Angle>-1 deg,Angle<0 deg),AND(ABS(Angle)>89 deg,ABS(Angle)<90 deg),AND(ABS(Angle)>90 deg,ABS(Angle)<91 deg),AND(ABS(Angle)>179 deg,ABS(Angle)<180 deg),AND(ABS(Angle)>180 deg,ABS(Angle)<181 deg)),2,0)

[Yacine]

I think that modifiying the color of all shapes just to correct their angle is a bad idea since they may have been colored otherwise on purpose. This work would be lost.Instead apply a "colored" layer to those shapes. After the correction remove the layer or remove the color from the layer.
Next idea, you may think about correcting the position automatically instead of coloring the shapes.

[wapperdude]

@Surrogate:  nice idea, but I think the OP has too many shapes to edit by hand, so would need code to add the formula.

@Yacine:  agree.  But, I couldn't come up with simple alternative nor think outside the box.  As I believe this is once and done, instead of changing line color, just set the angle to correct value.