ガントチャート、バーの変更

質問

VBAでガントチャートを作っています。

今時刻を入力しなおすと、「今ある
バーを消してから再度バーを生成する」という処理を
行っています。
'削除処理
Bar.Delete
'挿画処理
Set Bar(～)

といった感じです。これを、一度消してから
生成するのではなく、時刻が変わったら既存のバーを
「変更する」、といった形で行いたいと思っています。

詳しい回答をしていただきたいです。
よろしくお願いします。

回答No.1

end-u · ベストアンサー

Barとは何のObjectか、
時刻を入力する事によってBarがどう変動するのか、
現状の描画処理のコードはどういうコードか、

が書いてないのに『詳しい』回答はできないと思いますよ？

考え方としては、Bar 作成時に、一意の名前を付ければ済む話です。
『標準モジュール』に以下を置いて実行してください。

Sub pre()
　　Sheets.Add.Range("A1:C3").Value = [{"item","start","finish";"a",200,300;"b",400,500}]
End Sub

新規シートが追加されます。
できた新規シートの『シートモジュール』に以下を置いてください。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim r　　As Range　　 'Targetが範囲の場合のLoop用
　　Dim rect As Rectangle 'Shapeの四角形
　　Dim x　　As Long　　　'変更セルの行

　　With Me
　　　　Set Target = Intersect(Target, .Range("B2:C3"))
　　　　If Not Target Is Nothing Then
　　　　　　For Each r In Target
　　　　　　　　Select Case r.Column
　　　　　　　　　　Case 2
　　　　　　　　　　　　'startを変更した時の処理（割愛）
　　　　　　　　　　Case 3
　　　　　　　　　　　　'finishを変更した時の処理
　　　　　　　　　　　　x = r.Row
　　　　　　　　　　　　On Error Resume Next
　　　　　　　　　　　　Set rect = .Rectangles("rect" & x)
　　　　　　　　　　　　On Error GoTo 0
　　　　　　　　　　　　'名前 "rect" & x の四角形がない時は追加する。
　　　　　　　　　　　　If rect Is Nothing Then
　　　　　　　　　　　　　　Set rect = .Rectangles.Add(0, r.Top + 2, 0, 5)
　　　　　　　　　　　　　　rect.Name = "rect" & x
　　　　　　　　　　　　End If
　　　　　　　　　　　　rect.Left = r.Offset(, -1).Value
　　　　　　　　　　　　rect.Width = r.Value - r.Offset(, -1).Value
　　　　　　　　　　Case Else
　　　　　　　　End Select
　　　　　　Next
　　　　End If
　　End With
　　Set rect = Nothing
End Sub

C2 or C3を変更してみてください。
[win2000/xl2000]の環境で動作確認。2007では試していません。

ちなみに Bar が Shapeの四角形の事だとして、既存のShapeの名前を変更するには
Sub rName()
　　Dim rect As Rectangle

　　For Each rect In ActiveSheet.Rectangles
　　　　rect.Name = "rect" & rect.TopLeftCell.Row
　　Next
End Sub
こんな感じです。"rect" & 行No.にしています。

>VBAでガントチャートを作っています。
（以上は、Excel VBA と仮定した上でのアドバイスです）

お礼

説明が足りなかったのに丁寧にご回答くださりありがとうございます。

変更できました！
end-uさんのおっしゃるとおり、Barはオートシェイプで
Excel VBAでの質問でした。
ありがとうございました！