EXCEL VBA SHAPE OBJECT, BUTTON, WORKSHEET HELP
Hello All,
I sincerely would like some help with these Excel vba problem am stuck with. I already have some code written which i am trying to manipulate to achieve what i wanted, but certainly not working.
Here is my code:
Code:
Sub add_lamb()
Dim lamb As Shape
Dim ws As Worksheet
Dim iNumlamb As Variant
Dim i As Long
iNumlamb = InputBox("How many lamb ? ")
If Len(iNumlamb) = 0 Or iNumlamb < 1 Then Exit Sub
Sheets(1).Select
Range(Cells(1, 1), Cells(1000, 100)).Clear 'this should apply to the shapes not cells
With Worksheets("Sheet1")
For i = 1 To iNumlamb
.Cells(8, 2 + i).Value = "L" & i
If Not .Cells(11, 2 + i).Value = "" Then
.Cells(8, 2 + i).Interior.Color = RGB(100, 200, 255)
End If
Next i
End With
Set ws = ActiveSheet
Set lamb = ws.Shapes.AddShape(1, 200, 55, 40, 20)
lamb.Fill.ForeColor.RGB = RGB(100, 200, 255)
lamb.TextFrame.Characters.Text = "L"
lamb.TextFrame.Characters.Font.ColorIndex = 1
With lamb.TextFrame.Characters(1, 1)
End With
End Sub
Code:
Sub add_apple()
Dim apple As Shape
Dim ws As Worksheet
Dim iNumapple As Variant
Dim i As Long
iNumapple = InputBox("How many apple? ")
If Len(iNumapple) = 0 Or iNumapple < 1 Then Exit Sub
Sheets(1).Select
Range(Cells(1, 1), Cells(1000, 100)).Clear 'this should apply to the shapes not cells
With Worksheets("Sheet1")
For i = 1 To iNumapple
.Cells(11, 2 + i).Value = "A" & i
If Not .Cells(11, 2 + i).Value = "" Then
.Cells(11, 2 + i).Interior.Color = RGB(100, 255, 100)
End If
Next i
End With
Set ws = ActiveSheet
Set apple = ws.Shapes.AddShape(9, 250, 45, 30, 30)
apple.Fill.ForeColor.RGB = RGB(225, 100, 100)
apple.TextFrame.Characters.Text = "A"
apple.TextFrame.Characters.Font.ColorIndex = 1
With apple.TextFrame.Characters(1, 1)
End With
End Sub
Code:
Sub add_man()
Dim man As Shape
Dim ws As Worksheet
Dim iNumman As Variant
Dim i As Long
iNumman = InputBox("How many man? ")
If Len(iNumman) = 0 Or iNumman < 1 Then Exit Sub
Sheets(1).Select
Range(Cells(1, 1), Cells(1000, 100)).Clear 'this should apply to the shapes not cells
With Worksheets("Sheet1")
For i = 1 To iNumman
.Cells(15, 2 + i).Value = "M" & i
If Not .Cells(11, 2 + i).Value = "" Then
.Cells(15, 2 + i).Interior.Color = RGB(0, 255, 0)
End If
Next i
End With
Set ws = ActiveSheet
Set man = ws.Shapes.AddShape(17, 300, 45, 40, 30)
man.Fill.ForeColor.RGB = RGB(100, 225, 100)
man.TextFrame.Characters.Text = "M"
man.TextFrame.Characters.Font.ColorIndex = 1
With man.TextFrame.Characters(1, 1)
End With
End Sub
I have three sub procedures each for lamb, apple and man. And I have three buttons on the worksheet which i assigned to each procedure
Clicking on individual button should be independent of each other.
For example clicking on lamb button should do the following
-Ask how many lamb?
-type in number of lambs
-corresponding number of lambs -should appear cascaded on each other with textnumber of lamb enter with assigned colour code and shape
-and the shape should be able to move around the sheet to any location
The same applys to other two, with affecting each other (I have problem with this I guess because they are all on the same activesheet)
I managed to do the counting (L1, L2, ....) on the cell but should be with the individual shape type which correspond to the three objects
Thanks in anticipation for you help.
