関数・プロシージャの利用を考える

セル範囲から積み上げ棒グラフを作成し、追加のデータがあれば追加分グラフに適応するような場合を例に考えてみる。

背景色のないセルが元のデータ
黄色の背景色があるところがもともとなかった追加されたデータ。

チャート作成。

Private Sub CreateChart()

  Dim origin As Range

  Range("a1").Activate
  Set origin = ActiveCell.CurrentRegion

  With Worksheets(1).ChartObjects.Add(400, 50, 300, 200)
    .Chart.ChartType = xlColumnStacked
    .Chart.SetSourceData origin
  End With

End Sub

元データ

今回のRangeの取り方は追加データを見つければ同じプロシージャを呼ぶルーチンを書くだけ。

追加分

以前のチャートが・・・。

消す。

Private Sub CreateChart()

  Dim origin As Range

  Range("a1").Activate
  Set origin = ActiveCell.CurrentRegion

  With Worksheets(1).ChartObjects.Add(400, 50, 300, 200)
    .Chart.ChartType = xlColumnStacked
    .Chart.SetSourceData origin
  End With

End Sub

Private Sub DeleteChart()

  Worksheets(1).ChartObjects(1).Delete

End Sub

これだとチャートの無限増殖や存在しないチャートを消すかも。
呼び出しルーチンをつけ足す。

Private Sub Proc()

  Dim index as Long

  index = 1

  Call CreateChart(index)
  Call DeleteChart(index)
  index = index + 1

End Sub

Private Sub CreateChart(ByVal index as Long)

  If index > 1 Then
    Exit Sub
  End if

  Dim origin As Range

  Range("a1").Activate
  Set origin = ActiveCell.CurrentRegion

  With Worksheets(1).ChartObjects.Add(400, 50, 300, 200)
    .Chart.ChartType = xlColumnStacked
    .Chart.SetSourceData origin
  End With

End Sub

Private Sub DeleteChart(ByVal index as Long)

  Worksheets(1).ChartObjects(index).Delete

End Sub

CreateChart と DeleteChart に引数を付けたので Sub Proc() から呼び出すように制限できた。

もうちょっと気合入れて書いてみたけどこれたぶん、バグる・・。

Option Explicit

Private Type Rect

  dx As Long
  dy As Long
  width As Long
  height As Long

End Type

Private ChartCollection As New Collection
Private ChartName As String
Private ChartData As Range

Private Sub DeleteAllCharts()

  Dim w

  For Each w In Worksheets(1).ChartObjects
    w.Delete
  Next

End Sub

Private Sub Proc()

  Static count As Long

  If count = 0 Then
    Call CurrentTable
    Call CreateChart(ChartData)
  End If

  count = count + 1

  If Modified = True Then
    Call CurrentTable
    Call DeleteChart(ChartName)
    Call CreateChart(ChartData)
  End If

End Sub

Static Sub CurrentTable()

  Range("a1").Activate
  Set ChartData = ActiveCell.CurrentRegion

End Sub

Function Modified() As Boolean

  Range("a1").Activate

  If ActiveCell.CurrentRegion.address = ChartData.address Then

    Modified = False
    Exit Function

  End If

  Modified = True

End Function

Private Sub CreateChart(ByVal target As Range)

  Dim pos As Rect
  Dim chrt As ChartObject

  pos.dx = 400
  pos.dy = 50
  pos.height = 300
  pos.width = 200

  Set chrt = Worksheets("Sheet1").ChartObjects.Add(pos.dx, pos.dy, _
                                                   pos.height, pos.width)
  chrt.Chart.ChartType = xlColumnStacked
  chrt.Chart.SetSourceData target

  ChartCollection.Add Item:=chrt, Key:=chrt.name
  ChartName = chrt.name

  Debug.Print ChartName

End Sub

Private Sub DeleteChart(ByVal name As String)

  ChartCollection.Item(ChartName).Delete

End Sub

結論： On Error ステートメントは偉大だった。