|
すこし修正
Shapes.Add → Rectangles.Add
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) <> "J6" Then Exit Sub
On Error Resume Next
Me.Rectangles("myBar").Delete
On Error GoTo 0
Dim Value
Dim Left#, Width#
Dim Color As Long
Value = Range("J6").Value * 0.2
With Range("J7")
Select Case Value
Case Is > 0
Left = .Left
Width = Value
Color = 4
Case Is < 0 'マイナスの場合
Left = .Left + Value
Width = -Value
Color = 3
Case Else
Exit Sub
End Select
With Me.Rectangles.Add(Left, .Top, Width, 14)
.Interior.ColorIndex = Color
.Name = "myBar"
End With
End With
End Sub
|
|