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

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

![ori.PNG](https://qiita-image-store.s3.amazonaws.com/0/36817/be642a39-fc92-5e2d-09fe-14db502d970d.png)

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

チャート作成。

```vbnet

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

```

元データ

![cori.PNG](https://qiita-image-store.s3.amazonaws.com/0/36817/f793d224-acd1-30a0-f222-57f5b71da16b.png)

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

追加分

![Capture.PNG](https://qiita-image-store.s3.amazonaws.com/0/36817/50681a20-3628-6108-f5b3-018f6714ff72.png)

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

消す。

```vbnet

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

```


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

```vbnet

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() から呼び出すように制限できた。


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

```vbnet

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 ステートメントは偉大だった。