I am using VISIO to create a schematics. The idea is to change the shape color as a function as input.
Input here is current, output is the corresponding color. (0 mA as RGB(255,255,255) 850 mA as RGB(255,255,0))
I don't know what is wrong with my code. Please let me know if you have any suggestion. Thanks.
Sub Color()
Dim inputData As Long
Dim A_CIRCUIT_COLOR As Long
Dim Color As Integer
inputData = INPUTBOX("Input A Current:", "Input")
Color = -0.3188 * 50 + 270.94
A_CIRCUIT_COLOR = RGB(255, 255, Color)
'Enable diagram services
Dim DiagramServices As Integer
DiagramServices = ActiveDocument.DiagramServicesEnabled
ActiveDocument.DiagramServicesEnabled = visServiceVersion140
Dim UndoScopeID1 As Long
UndoScopeID1 = Application.BeginUndoScope("Line Color")
Application.ActiveWindow.Page.Shapes.ItemFromID(1135).CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = "A_CIRCUIT_COLOR"
Application.EndUndoScope UndoScopeID1, True
End Sub
Your code doesn't use the input data at all, the formula for Color evaluates to 255 so you are always setting RGB(255,255,255).
.
i think it formula is correct
Color = 255-INT(0.3*inputData)
Hello Paul,
I should change Color = -0.3188 * 50 + 270.94 to Color = -0.3188 * inputData + 270.94 so I am using the input data.
After the change I run the program, it shows run-time error '-2032466904(86db0425): #NAME?
If I change Application.ActiveWindow.Page.Shapes.ItemFromID(1135).CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = "A_CIRCUIT_COLOR" to Application.ActiveWindow.Page.Shapes.ItemFromID(1135).CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = A_CIRCUIT_COLOR
the color is always black.
Color variable must be whole number!!!
0 to 255
There is a shapesheet solution which avoids using a macro. It uses the SETATREF function. For more info on SETATREF(), see post in User-supplied section: What's with SETATREF anyway? http://visguy.com/vgforum/index.php?topic=6383.0 (http://visguy.com/vgforum/index.php?topic=6383.0)
The attached file has a line shape with the functionality of changing the value of current per Shape Data Entry. As configured in this example, the allowable range of current is 0 to 10. A Bound function limits the RGB calculated results to a range of 0 to 255, regardless of Shape Data values. Within the bound function, is the INT (integer) function, which restricts values to whole numbers. This is required for the RGB formula.
HTH
Wapperdude.
I had a similar problem as I wanted to use variables for the RGB components. I could find any solutions in the many forums until the penny dropped. To change the colour is simply
[code]Application.ActiveWindow.Page.Shapes.ItemFromID(1135).CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = "RGB(" & ColR & "," & ColG & "," & ColB & ")"
but in your case, it's even simpler
Application.ActiveWindow.Page.Shapes.ItemFromID(1135).CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = "RGB(255, 255," & Color & ")"
Regards
NoClass2980