Sleeper: VBA Change Line colors

[Troy73]

Can someone help me figure out how to change the color of my lines for each line? Also, the last variable that I have "BackTopY_No_Touch" is just so the drawing doesn't fill, it would be amazing if you could include how to not fill the object once it is complete.


Sub DrawFreeform()
Call DeleteShapes
Dim ws As Worksheet, fb As FreeformBuilder
Set ws = ActiveSheet
BackBottomY = 300
FrontBottomY = 350
FrontTopY = 100
BackTopY = 50
BackTopX = 50
BackBottomX = 50
FrontBottomX = 150
FrontTopX = 150
BackTopY_No_Touch = 51
Set fb = ws.Shapes.BuildFreeform(msoEditingAuto, 50, 50)
fb.AddNodes msoSegmentLine, msoEditingAuto, BackBottomX, BackBottomY
fb.AddNodes msoSegmentLine, msoEditingAuto, FrontBottomX, FrontBottomY
fb.AddNodes msoSegmentLine, msoEditingAuto, FrontTopX, FrontTopY
fb.AddNodes msoSegmentLine, msoEditingAuto, BackTopX, BackTopY_No_Touch
fb.ConvertToShape
End Sub

[Aussiebear]

Welcome VBAX Troy73. Posting code so we can't read it is one of the best ways to not get any assistance. I have edited your code to try and get you some assistance.

[Grade4.2]

You can set line color for a shape in Excel VBA by accessing the Line property of the Shape object, which itself has a ForeColor property. For the ForeColor property, you set it with a RGB function to define a color.


The Fill of the shape can be set to "No Fill" by using the Fill property of the Shape object, which has a Visible property that can be set to msoFalse.


However, it's important to note that when you're creating a Freeform, all lines will have the same color. If you want different lines to have different colors, you'll need to create separate shapes.


The adjusted code to apply these changes would look like this:



Sub DrawFreeform() Call DeleteShapes
Dim ws As Worksheet, fb As FreeformBuilder, shp As Shape
Set ws = ActiveSheet
BackBottomY = 300
FrontBottomY = 350
FrontTopY = 100
BackTopY = 50
BackTopX = 50
BackBottomX = 50
FrontBottomX = 150
FrontTopX = 150
BackTopY_No_Touch = 51
Set fb = ws.Shapes.BuildFreeform(msoEditingAuto, 50, 50)
fb.AddNodes msoSegmentLine, msoEditingAuto, BackBottomX, BackBottomY
fb.AddNodes msoSegmentLine, msoEditingAuto, FrontBottomX, FrontBottomY
fb.AddNodes msoSegmentLine, msoEditingAuto, FrontTopX, FrontTopY
fb.AddNodes msoSegmentLine, msoEditingAuto, BackTopX, BackTopY_No_Touch
Set shp = fb.ConvertToShape

' Set line color
shp.Line.ForeColor.RGB = RGB(255, 0, 0) ' Red color

' No Fill
shp.Fill.Visible = msoFalse
End Sub


In this example, the line color is set to red (RGB(255, 0, 0)) for the entire shape. Adjust as per your requirements.


For separate color for each line, you might need to draw separate shapes (lines) instead of one continuous freeform. You can use ws.Shapes.AddLine method for this.




Sub DrawLines()
Dim ws As Worksheet
Dim lineShape As Shape
Set ws = ActiveSheet

' Delete all existing shapes
For Each shp In ws.Shapes
shp.Delete
Next shp

' Add first line (red)
Set lineShape = ws.Shapes.AddLine(10, 10, 100, 100)
lineShape.Line.ForeColor.RGB = RGB(255, 0, 0) ' Red color

' Add second line (green)
Set lineShape = ws.Shapes.AddLine(100, 100, 200, 200)
lineShape.Line.ForeColor.RGB = RGB(0, 255, 0) ' Green color

' Add third line (blue)
Set lineShape = ws.Shapes.AddLine(200, 200, 300, 300)
lineShape.Line.ForeColor.RGB = RGB(0, 0, 255) ' Blue color
End Sub




In this example, ws.Shapes.AddLine is used to create three lines. The AddLine method takes four arguments: the beginning (x1, y1) and end (x2, y2) points of the line. Each line is then given a different color.

[p45cal]

See also cross posts:
https://www.excelforum.com/excel-programming-vba-macros/1407411-drawing-an-object-with-different-colors.html
https://learn.microsoft.com/en-us/answers/questions/1309233/drawing-object-and-change-line-colors

[Aussiebear]

@P45cal, Yes it very disappointing to see cross posting going on.

[jolivanes]

@ Aussiebear.
Fully agree but sometimes understandable. What gets me more so is the not acknowledging that they did not play by the rules. A simple "I am sorry" is so easy to do.
On top of that is that quite often no posting anymore to thank the people that offered their free time to help or even to say that it worked or even that it maybe did not work.
I guess people will always be people.

@Grade4.2
Using "Visible = msoFalse" can sometimes make you look why inserting a picture after into the shape is not visible.
You have to make sure you set the Visibility to msoTrue again when doing that.
Personally I prefer

.Fill.Transparency = 1

[Aussiebear]

@ Aussiebear.
Fully agree but sometimes understandable. What gets me more so is the not acknowledging that they did not play by the rules. A simple "I am sorry" is so easy to do.
On top of that is that quite often no posting anymore to thank the people that offered their free time to help or even to say that it worked or even that it maybe did not work.
I guess people will always be people.

I couldn't agree with you more. Recently, I been going through the older threads (nearly 20 years ago) in excel to bring them up to standards required by this version of vBulletin. The things we request today, such notifying of cross posting, thanking people for replies or indicating whether something offered as a solution worked, were missing back then as well. So it's not a generational thing, more so I suspect a complete lack of understanding of how to work in a team environment. I'm sure you see the same things in the other forums you generously participate in as well.

[Paul_Hossler]

@all re x-posting

IMHO I can forgive a first or second time poster who multiposts or doesn't mark a thread SOLVED since they're probably just learning the ropes and BB etiiquette.

After all, who really reads the FAQs (well, AussieBear of course :) ).

Many times I'll request they mark it SOLVED, but I think since they got a good answer, they never visited to read my request and it just sits there:(

I'll just point them to the right links and try to explain.

If that doesn't seem to work, then I'll just ignore them since I'm old and crotchy

[jolivanes]

Whatever you say, you're going to hurt some peoples feelings but all I can say that my parents told me to always thank people that help you.
And now I read that Paul_H is trying to catch up with me age wise to get the T-Shirt from me that says: "Been there, done that, have the t-shirt to prove it."

[Aussiebear]

"Been there, done that, have the t-shirt to prove it."

You young'uns.... Been there done that, got the slate to prove it.

[Paul_Hossler]

t the T-Shirt ...that says: "Been there, done that, have the t-shirt to prove it."

Mine wore out a long time ago

[Aussiebear]

Hmmm.... it been a couple of days now and my guess is that Troy73 hasn't found the courage to reply either by apologising for not posting information regarding cross posting or commenting on whether the response by Grade 4.2 worked. Sad that..... really sad.

[jolivanes]

Probably did not want people to know that there are more. And who knows, there are more sites yet but I don't go to all of them.
https://chandoo.org/forum/threads/vba-draw-lines-and-change-colors.53795/