エクセルでのオートシェイプについての質問です。

質問

エクセルでのオートシェイプについての質問です。
エクセルのシートの一定の決まったセルに数字を打ち込むとそれに連動してオートシェイプの矢印の長さを変更できるようにしたいのですが、わかる方いますでしょうか？
例えばB1に「1.0」、B2に「1.5」、B3に「2.0」を入力した場合、連動してc1,c2,c3にある矢印の長さが変わるものです。
VBAを理解したいのですが、できれば、コピー貼付けできるコードを教えていただきたいのです。

回答No.3

watabe007 · ベストアンサー

>>>例えばB1に「1.0」、B2に「1.5」、B3に「2.0」を入力した場合
>>Ｂ１のセルが＝Ａ１*30という形ではうまくいきません。
>ただ、Ａ１セルは、＝Ｄ１/Ｅ１なのです。
最後です。Ｄ１～Ｅ３何れかのセルに数値を入力されればＢ列の数値で長さが変化します。
Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim sha As Shape

　　With Target
　　　　If Intersect(.Cells, Range("D1:E3")) Is Nothing Then Exit Sub
　　　　If Not IsNumeric(.Value) Then Exit Sub
　　　　For Each sha In ActiveSheet.Shapes
　　　　　　If sha.TopLeftCell.Address = Cells(.Row, "C").Address Then
　　　　　　　　sha.Width = Cells(.Row, "B").Value
　　　　　　End If
　　　　Next
　　End With
End Sub

お礼

感謝いたします。助かりました。

回答No.2

watabe007

>Ｂ１のセルが＝Ａ１*30という形ではうまくいきません。
計算式で値が変わってもChangeイベントが動きません。
Ａ１セルでChangeイベントが動くようにすれば良いでしょう

補足

確かにおっしゃる通りです。
数字をペーストで貼りつけるだけでも、Changeイベントは動かないみたいです。
ただ、Ａ１セルは、＝Ｄ１/Ｅ１なのです。こういう場合、どこを変えればよろしいでしょうか。

回答No.1

watabe007

シートモジュールに
Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim sha As Shape

　　With Target
　　　　If Intersect(.Cells, Range("B1:B3")) Is Nothing Then Exit Sub
　　　　If Not IsNumeric(.Value) Then Exit Sub
　　　　For Each sha In ActiveSheet.Shapes
　　　　If sha.TopLeftCell.Address = .Offset(, 1).Address Then
　　　　　　sha.Width = .Value * 10
　　　　　　End If
　　　　Next
　　End With
End Sub

補足

素早い回答で、感謝します。ただ、Ｂ１のセルが＝Ａ１*30という形ではうまくいきません。
Ｂ１のセルが計算式では、不可能なのでしょうか。