frank_m
12-13-2010, 06:09 PM
With the code below I am creating an AutoShapeCross and positioning it relative to the active cell and row.
Later I may be selecting a different cell in a different row, but need the macro that is assigned to the AutoShapeCross to when clicked change the value in the cell where the Cross is positioned. - The string value I want entered into the cell is "Complete".
I believe it is possible using the top or left position of the Cross, but I have no idea how to code it.
The Cross is always named "MyShapeCross"
Thank you much for some insight.
Sub Macro1()
Dim TopPos As Integer
Dim LeftPos As Integer
Dim intWidth As Integer
Dim intHeight As Integer
TopPos = ActiveCell.Offset(0, 10 - ActiveCell.Column).Top
intWidth = 18
intHeight = 18
LeftPos = ActiveCell.Offset(0, 10 - ActiveCell.Column).Left
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If shp.AutoShapeType = msoShapeCross Then
shp.Delete
End If
Next shp
DoEvents
Set shp = ThisWorkbook.Worksheets("Sheet1").Shapes.AddShape(msoShapeCross, _
LeftPos, TopPos, intWidth, intHeight)
With shp
.Name = "MyShapeCross"
.Placement = xlMoveAndSize
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.SchemeColor = 12
.OnAction = "ChangeValue_inCellRelativeTo_Cross"
End With
End Sub
Later I may be selecting a different cell in a different row, but need the macro that is assigned to the AutoShapeCross to when clicked change the value in the cell where the Cross is positioned. - The string value I want entered into the cell is "Complete".
I believe it is possible using the top or left position of the Cross, but I have no idea how to code it.
The Cross is always named "MyShapeCross"
Thank you much for some insight.
Sub Macro1()
Dim TopPos As Integer
Dim LeftPos As Integer
Dim intWidth As Integer
Dim intHeight As Integer
TopPos = ActiveCell.Offset(0, 10 - ActiveCell.Column).Top
intWidth = 18
intHeight = 18
LeftPos = ActiveCell.Offset(0, 10 - ActiveCell.Column).Left
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If shp.AutoShapeType = msoShapeCross Then
shp.Delete
End If
Next shp
DoEvents
Set shp = ThisWorkbook.Worksheets("Sheet1").Shapes.AddShape(msoShapeCross, _
LeftPos, TopPos, intWidth, intHeight)
With shp
.Name = "MyShapeCross"
.Placement = xlMoveAndSize
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.SchemeColor = 12
.OnAction = "ChangeValue_inCellRelativeTo_Cross"
End With
End Sub