Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


14312 / 76734 ←次へ | 前へ→

【67919】Re:オートシェイプのマイナス作成について
発言  kanabun  - 11/1/17(月) 10:02 -

引用なし
パスワード
   すこし修正
  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
6 hits

【67915】オートシェイプのマイナス作成について Imai 11/1/16(日) 23:43 質問
【67916】Re:オートシェイプのマイナス作成について 山猿 11/1/17(月) 0:01 発言
【67917】Re:オートシェイプのマイナス作成について kanabun 11/1/17(月) 0:24 発言
【67919】Re:オートシェイプのマイナス作成について kanabun 11/1/17(月) 10:02 発言
【67923】Re:オートシェイプのマイナス作成について Imai 11/1/17(月) 12:05 質問

14312 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free