need help writing a program...

[Krickette]

OK, I'm not even sure if vba does what I need it to do, but I don't have enough experience with it to know. I need to write a program... I have some experience with c and Java and HTML and assembly and pbasic, so I know some things, but I've not written many standalone programs and the few I did I used greenfoot to write.
I need to collect data on hands. The Dr I'm working for wants a program that shows the hand and color codes it according to what number is selected for that region of the hand. I want the information to be linked to an excel file, so that when, for instance, a 2 is entered in zone 1, it color codes zone 1 green in the picture of the hand, and enters a 2 in a chart under "zone 1"
hopefully this way I'll be able to make a graph of the data showing patients' improvements.
I have no idea how I'm going to do this. I mean, I know how to do some parts, but I'm sure there's simpler ways. I just don't have a starting point to start researching.
Could y'all help me any? I'll post some pictures and more information tonight when I can get to a computer...

[Chabu]

I'll post some pictures and more information tonight when I can get to a computer...

So how are you posting this?

[Bob Phillips]

Sounds like you want Conditional Formatting http://www.xldynamic.com/source/xld.CF.html

[Krickette]

Haha, I was on my phone earlier. Hard to post anything but text from there.
So this is the code I've come up with so far.
[VBA]Sub ColorShape55()
ActiveSheet.Shapes("Freeform 55").Select
If Range("hand!O16").Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 153, 51)
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
ElseIf Range("hand!O16").Value = 2 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(51, 51, 255)
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
ElseIf Range("hand!O16").Value = 3 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(102, 0, 153)
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
ElseIf Range("hand!O16").Value = 4 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(153, 0, 0)
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
ElseIf Range("hand!O16").Value = 5 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 153, 0)
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
ElseIf Range("hand!O16").Value = 6 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(138, 138, 138)
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
End If
End Sub
[/VBA]

I have four main problems:
1. How do I trigger this to run automatically? So that when someone changes the inputs, the shapes automatically change colors.

2. Is it possible to change the shape numbers? I currently can't figure out a "clean" way to do this (ie using ++ loops to run through all shapes). My shapes range from 9 to 55 and there are missing ones, because I had to delete several during my drawing. So do I have to copy paste and edit this loop all 47 times?

3. If I do have to do this over and over and over, do I do a separate module for each time, or do it all in one module?

4. Is this the best way to do what I'm doing?


I have pics, but I can't post them cause my post count is too low... pm me if you care to see!

[Bob Phillips]

Post your workbook.

[Krickette]

Here you go, I didn't even realize we could, haha!
Thank you

[shrivallabha]

You have used listboxes available in form control.
I guess what you are after is and should do:
This is for one control:
1. Select listbox7 and right click on it. It will provide options.
2. Choose assign macro then the default macro which is ListBox7_Change will be displayed.
3. Click on New option. VBE will be opened.
4. Copy the colorshape10 macro code and paste it in this event. So finally it will look like:
[VBA]Sub ListBox7_Change()
ActiveSheet.Shapes("Freeform 10").Select
If Range("hand!P3").Value = 1 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 153, 51)
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
ElseIf Range("hand!P3").Value = 2 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(51, 51, 255)
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
ElseIf Range("hand!P3").Value = 3 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(102, 0, 153)
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
ElseIf Range("hand!P3").Value = 4 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(153, 0, 0)
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
ElseIf Range("hand!P3").Value = 5 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 153, 0)
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
ElseIf Range("hand!P3").Value = 6 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(138, 138, 138)
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
Else
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
End If
End Sub[/VBA]

Repeat this procedure with the other controls if this is what you need!

[Paul_Hossler]

Your's is a lot more detailed than I created

I just used simple shapes and named them and had them respond to clicks

But this might offer some suggestions to consider

Paul

[vba]
Option Explicit

Sub Thumb_Click()
Call ColorShape("Thumb", ActiveSheet.Range("H4"))
End Sub
Sub Pointer_Click()
Call ColorShape("Pointer", ActiveSheet.Range("H5"))
End Sub
Sub IndexFinger_Click()
Call ColorShape("IndexFinger", ActiveSheet.Range("H6"))
End Sub
Sub RingFinger_Click()
Call ColorShape("RingFinger", ActiveSheet.Range("H7"))
End Sub
Sub LittleFinger_Click()
Call ColorShape("LittleFinger", ActiveSheet.Range("H8"))
End Sub
Sub HandPalm_Click()
Call ColorShape("HandPalm", ActiveSheet.Range("H9"))
End Sub
Sub PalmHeel_Click()
Call ColorShape("PalmHeel", ActiveSheet.Range("H10"))
End Sub

Private Sub ColorShape(sShape As String, oRange As Range)

If oRange.Value < 0 Then oRange.Value = 0
oRange.Value = oRange.Value + 1
If oRange.Value = 7 Then oRange.Value = 1

With ActiveSheet.Shapes(sShape)
Select Case oRange.Value
Case 1
.Fill.ForeColor.RGB = RGB(0, 153, 51)
.Line.ForeColor.RGB = RGB(0, 0, 0)
Case 2
.Fill.ForeColor.RGB = RGB(51, 51, 255)
.Line.ForeColor.RGB = RGB(0, 0, 0)
Case 3
.Fill.ForeColor.RGB = RGB(102, 0, 153)
.Line.ForeColor.RGB = RGB(0, 0, 0)
Case 4
.Fill.ForeColor.RGB = RGB(255, 153, 0)
.Line.ForeColor.RGB = RGB(0, 0, 0)
Case 5
.Fill.ForeColor.RGB = RGB(255, 153, 0)
.Line.ForeColor.RGB = RGB(0, 0, 0)
Case 6
.Fill.ForeColor.RGB = RGB(138, 138, 138)
.Line.ForeColor.RGB = RGB(0, 0, 0)
End Select
End With
End Sub
[/vba]

[Krickette]

shrivallabha, thank you very much! That's very helpful! And thank you, Paul! I'll dig around through that code, too!
So I can just remove the other modules then?
I think I'm going to rewrite so that it just changes according to that box, instead of having it copy to a cell and then read the cell, that seems like a wasted step.

Also, I'll need to find codes for how to record this data. I'm figuring I can just add a line under each of the color changes saying something like

ElseIf Range("hand!P3").Value = 4 Then
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(153, 0, 0)
Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
record "6" in cell A3...

and so on...

[Krickette]

Paul, I would PM you, but I can't yet with my post count. How did you rename the shapes?

ETA: nevermind, haha! I feel silly!

[Bob Phillips]

Try this

[Paul_Hossler]

You might have to re-think individual dropdowns for each piece

Clutters the screen, and they're really very small (too small)

Maybe click on a segment and display the same down to update data???

Paul

[Paul_Hossler]

See if this works as a starting point for you

I used the click on a segment to 'roll the reading', but you can play around

[vba]
Option Explicit
Dim aryValues As Variant
'I'd eventually put this in Worksheet Open

Sub Init()
Dim oShape As Shape

For Each oShape In Worksheets("Hand").Shapes
oShape.OnAction = "FingerClick"
Next

'remember -- 0 - 7
aryValues = Array("'2", "'3", "'4", "'5", "'6", "'6.6", "redline", "NA")
End Sub

Private Sub FingerClick()
Dim sShapeName As String
Dim iReading As Long, iPart As Long

With Worksheets("Hand")
sShapeName = .Shapes(Application.Caller).Name

iPart = Application.WorksheetFunction.Match(sShapeName, .Range("M:M"), 0)
iReading = .Cells(iPart, 14).Value

If .Cells(iPart, 14).Value < LBound(aryValues) Then .Cells(iPart, 14).Value = LBound(aryValues)
.Cells(iPart, 14).Value = .Cells(iPart, 14).Value + 1
If .Cells(iPart, 14).Value > UBound(aryValues) Then .Cells(iPart, 14).Value = LBound(aryValues)

.Cells(iPart, 15).Value = aryValues(.Cells(iPart, 14).Value)

With .Shapes(sShapeName)
Select Case Worksheets("Hand").Cells(iPart, 14).Value
Case 0
.Fill.ForeColor.RGB = RGB(0, 153, 51)
.Line.ForeColor.RGB = RGB(0, 0, 0)
Case 1
.Fill.ForeColor.RGB = RGB(51, 51, 255)
.Line.ForeColor.RGB = RGB(0, 0, 0)
Case 2
.Fill.ForeColor.RGB = RGB(102, 0, 153)
.Line.ForeColor.RGB = RGB(0, 0, 0)
Case 3
.Fill.ForeColor.RGB = RGB(255, 153, 0)
.Line.ForeColor.RGB = RGB(0, 0, 0)
Case 4
.Fill.ForeColor.RGB = RGB(255, 153, 0)
.Line.ForeColor.RGB = RGB(0, 0, 0)
Case 5
.Fill.ForeColor.RGB = RGB(138, 138, 138)
.Line.ForeColor.RGB = RGB(0, 0, 0)
Case 6
.Fill.ForeColor.RGB = RGB(138, 138, 138)
.Line.ForeColor.RGB = RGB(0, 0, 0)
Case 7
.Fill.ForeColor.RGB = RGB(138, 138, 138)
.Line.ForeColor.RGB = RGB(0, 0, 0)
End Select
End With
End With
End Sub
[/vba]


Paul

[Krickette]

Wow, Paul, I'll have to try that! It looks super complicated haha, I'm kinda scared.

I just finished redoing this one. Still can't figure out how to record the data! I want it to go on a new sheet, but I guess that doesn't matter as much now, I just want it all somewhere. I keep googling how to change the value of a cell, and I keep trying what they say, and nothing is working...

[Paul_Hossler]

Not very complicated, just trace your way though it -- best way to learn

Didn't understand your question about changing the value of a cell

BTW, if you want to initialize the colors, add something like this to the Init
sub

[VBA]
With Worksheets("hand")
For i = 2 To .Cells(1, 13).CurrentRegion.Rows.Count
Set oShape = .Shapes(.Cells(i, 13).Value)
Select Case .Cells(i, 14).Value
Case 0
oShape.Fill.ForeColor.RGB = RGB(0, 153, 51)
oShape.Line.ForeColor.RGB = RGB(0, 0, 0)
Case 1
oShape.Fill.ForeColor.RGB = RGB(51, 51, 255)
oShape.Line.ForeColor.RGB = RGB(0, 0, 0)
Case 2
oShape.Fill.ForeColor.RGB = RGB(102, 0, 153)
oShape.Line.ForeColor.RGB = RGB(0, 0, 0)
Case 3
oShape.Fill.ForeColor.RGB = RGB(255, 153, 0)
oShape.Line.ForeColor.RGB = RGB(0, 0, 0)
Case 4
oShape.Fill.ForeColor.RGB = RGB(255, 153, 0)
oShape.Line.ForeColor.RGB = RGB(0, 0, 0)
Case 5
oShape.Fill.ForeColor.RGB = RGB(138, 138, 138)
oShape.Line.ForeColor.RGB = RGB(0, 0, 0)
Case 6
oShape.Fill.ForeColor.RGB = RGB(138, 138, 138)
oShape.Line.ForeColor.RGB = RGB(0, 0, 0)
Case 7
oShape.Fill.ForeColor.RGB = RGB(138, 138, 138)
oShape.Line.ForeColor.RGB = RGB(0, 0, 0)
End Select
Next i
End With
[/VBA]

Paul

[Krickette]

I'd like for every time something gets clicked, for it to change the value recorded in a table on the "Data" sheet. That way later on I can use this data more easily later on, should we need to write a paper on it or something.
But I can't figure out how to do that. If you look on what I uploaded, I tried to add an extra part to each case, that would do what I'm trying to do, but it failed miserably.

Also, with these two things you just showed me, do those go in a module or under This Workbook or one of the sheets or what? I'm very novice, haha

[Bob Phillips]

Did you look at mine?

[Krickette]

xld, I've been attempting to look at yours... This is all very confusing to me, so I'm not sure what to follow in yours.

[Bob Phillips]

Try changing some of the numbers and watch it go.

[Krickette]

This is my program so far. Not so much mine, though, haha! Anyway, I finally got the data to record correctly, so that's exciting!
I'm still trying to look at the scrolling one that Paul put up, cause that sounds really cool, but I'm having trouble with the Active.Caller thing.

And XLD, I can't get it to work, I don't think. I clicked the numbers, and it just changes the numbers in that little area off to the right...