View Full Version : need help writing a program...
Krickette
06-22-2011, 09:33 AM
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
06-22-2011, 02:16 PM
I'll post some pictures and more information tonight when I can get to a computer...
So how are you posting this?:wot
Bob Phillips
06-22-2011, 02:16 PM
Sounds like you want Conditional Formatting http://www.xldynamic.com/source/xld.CF.html
Krickette
06-23-2011, 06:18 AM
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.
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
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
06-23-2011, 07:14 AM
Post your workbook.
Krickette
06-23-2011, 07:18 AM
Here you go, I didn't even realize we could, haha!
Thank you
shrivallabha
06-23-2011, 07:34 AM
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:
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
Repeat this procedure with the other controls if this is what you need!
Paul_Hossler
06-23-2011, 07:35 AM
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
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
Krickette
06-23-2011, 07:54 AM
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
06-23-2011, 08:09 AM
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
06-23-2011, 08:17 AM
Try this
Paul_Hossler
06-23-2011, 09:07 AM
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
06-23-2011, 10:14 AM
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
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
Paul
Krickette
06-23-2011, 10:24 AM
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
06-23-2011, 10:29 AM
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
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
Paul
Krickette
06-23-2011, 10:33 AM
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
06-23-2011, 10:35 AM
Did you look at mine?
Krickette
06-23-2011, 10:41 AM
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
06-23-2011, 11:12 AM
Try changing some of the numbers and watch it go.
Krickette
06-23-2011, 11:24 AM
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...
Paul_Hossler
06-23-2011, 01:33 PM
but I'm having trouble with the Active.Caller thing.
Application.caller is the way to see which shape was clicked since it's easier to have one macro handle 50 shapes, than to have 50 macros each handling one shape
In col N and in col O I captured the data values
How were you thinking you wanted to record them?
Paul
Bob Phillips
06-23-2011, 01:35 PM
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...
No, the corresponding hand areas also change colour.
jolivanes
06-26-2011, 01:55 PM
You could also change colors with a UserForm
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.