■以下のようなWBSを作成します。
■作成ボタンに登録するマクロ(コード)
Sub WBS作成() Dim shp As Shape Dim org As Range Dim dst As Range Dim trgt As Range Dim days As Range Dim wsPrf As Worksheet Dim ctg As Range Set wsPrf = Worksheets("設定") Set days = Range(Range("E2"), Range("E2").End(xlToRight)) For Each trgt In Range(Range("C3"), Range("C3").End(xlDown)) '開始日に一致するセルを探す Set org = days.Find(trgt, , , xlWhole) '終了日に一致するセルを探す Set dst = days.Find(trgt.Offset(0, 1), , , xlWhole) '矢印線の開始位置と終了位置を設定 Set shp = ActiveSheet.Shapes.AddLine(org.Left + org.Width / 2, _ trgt.Top + trgt.RowHeight / 2, dst.Left + dst.Width / 2, _ trgt.Top + trgt.RowHeight / 2) '設定シートA4~A7の範囲よりSheet1のA列(分類)の項目と合致するセルを検出 Set ctg = wsPrf.Range("A4:A7").Find(trgt.Offset(0, -2).Value, , , xlWhole) With shp.Line '設定シートよりセルの幅の値を取得 .Weight = wsPrf.Range("B1").Value '設定シートのB列より色を取得 .ForeColor.RGB = ctg.Offset(0, 1).Interior.Color '線のスタイルを矢印に設定 .EndArrowheadStyle = msoArrowheadTriangle End With Next End Sub
■削除ボタンに登録するマクロ(コード)
Sub 矢印を削除() Dim shp As Shape 'シート内の矢印線のみ削除する For Each shp In ActiveSheet.Shapes If shp.Type = msoLine Then shp.Delete End If Next End Sub