[[20110918073721]]　『グラフの一括作成』（モリ）　ページの最後に飛ぶ

『グラフの一括作成』（モリ）

 こちらに載っていた回答を参考にグラフを一括して作成しようと思っているの
 ですが、途中でわからなくなりました。どなたかご教授下さい。

 1グループ目のデータがA2～M22にあり、2行目が見出し項目、3行目～22行目がデータ
 2グループ目のデータがA25～M45で、25行目が見出し項目、26行目～45行目がデータ
 といった感じで、3行おきに20データ（見出しを除く）が5グループ分並んでいます。（最終行は117行目）

 A3:A22を1グループ目の項目軸ラベル、H2:M2を名前、H3:M22を値として積み上げ縦棒グ ラフを作成。
 Y軸は最大値を16時間、メモリ間隔を8時間で表示させています。　
　　  　A     B      C     D         E         F     G       H     I     J     K　　 L　　 M
 2行目 型番　型名　 副番　開始時間　終了時間　合計　その他　A工程 B工程 C工程 D工程 E工程 F工程　
 3行目 AAA  あああ  a     09:18     22:11     12:53 01:43   04:09 00:00 00:02 00:03 01:00 05:53
 4行目
   ・
　 ・
 22行目

 各グループのデータ範囲の前面にグラフを作成して表示させたいのですが、現在のマクロでは
 ひとつのグラフのデータ範囲が変更になっていくだけで、複数のグラフにできません。
 繰り返しの処理の仕方がよくわからず、このコードをどのように直せばいいのかわからないので、
 どなたか教えて下さい。
 よろしくお願いします。

 Option Explicit
 Sub データ範囲を換えてグラフを描く()
 Dim ラベル範囲 As String
 Dim データ範囲 As String
 Dim グラフ範囲 As Range
 Dim MyChart As ChartObject
 Dim MyMax As Long
 Static i As Long
 With Sheets("Sheet1")
    MyMax = .Range("A3", .Range("A65536").End(xlUp)).Rows.Count
    ラベル範囲 = "A2,H2:M2," & .Range("A3").Offset(i).Resize(20).Address(0, 0)
    データ範囲 = ラベル範囲 & "," & .Range("H3:M3").Offset(i).Resize(20).Address(0, 0)
    Set グラフ範囲 = .Range("C3:M22")
    On Error Resume Next
        Set MyChart = .ChartObjects(1)
    On Error GoTo 0
    If MyChart Is Nothing Then
        Set MyChart = .ChartObjects.Add( _
        グラフ範囲.Left, グラフ範囲.Top, グラフ範囲.Width, グラフ範囲.Height)
    End If
 End With
 With MyChart.Chart
    .ChartType = xlColumnStacked
    .SetSourceData Source:=Sheets("Sheet1").Range(データ範囲), PlotBy:=xlColumns
    .PlotArea.Width = 450
    .PlotArea.Height = 200
    .Axes(xlCategory).TickLabels.Font.Size = 12
 End With
 i = i + 23
 If MyMax <= i Then i = 0
 Set MyChart = Nothing
 Set グラフ範囲 = Nothing
 End Sub

 Excel2000 Windows

 表示位置とデータ範囲とオブジェクトを変えていく必要がありますが、

 現在のコードはChartObject(1) があるとそこに描画するようになっていますね。
 ですから、その If 文は不要だと思います。

 グラフ範囲が固定になっているので、こちらにも Offset を追加が必要です。

 そんなところで、とりあえず動かないでしょうか。
 一度に作成してよいなら全体をループしてもよいと思いますが。
 (Mook)

 Mook様

 Set グラフ範囲 = .Range("C3:M22")
   On Error Resume Next
        Set MyChart = .ChartObjects(1)
    On Error GoTo 0
    If MyChart Is Nothing Then
        Set MyChart = .ChartObjects.Add( _
        グラフ範囲.Left, グラフ範囲.Top, グラフ範囲.Width, グラフ範囲.Height)
    End If
 End With

 上記のコードを下記のように変えてみましたが、いままでと同じでした。
 変更の仕方が間違っているのでしょうか？

 Set グラフ範囲 = .Range("C3:M22").Offset(i)
    On Error Resume Next
        Set MyChart = .ChartObjects(1)
    On Error GoTo 0

 End With

 それからループで処理できそうだということまではわかったのですが、どのようにコード
 をかけばいいのかわからず、もう少し詳しく教えて頂けないでしょうか？

 (モリ）

    On Error Resume Next
        Set MyChart = .ChartObjects(1)
    On Error GoTo 0
 自体が不要ということです。これがあるために同じところを描画してしまいます。

 グラフを毎回描画しなおすとすると削除も必要ですね。

 Sub データ範囲を換えてグラフを描く()
    Dim ラベル範囲 As String
    Dim データ範囲 As String
    Dim グラフ範囲 As Range
    Dim MyChart As ChartObject

    With Sheets("Sheet1")
        For Each MyChart In .ChartObjects
            MyChart.Delete
        Next

        Dim i As Long
        For i = 0 To 115 Step 23
            ラベル範囲 = .Range("A2,H2:M2").Offset(i, 0).Address(0, 0) & "," & _
                         .Range("A3").Offset(i, 0).Resize(20).Address(0, 0)
            データ範囲 = ラベル範囲 & "," & .Range("H3:M3").Offset(i, 0).Resize(20).Address(0, 0)
            Set グラフ範囲 = .Range("C3:M22").Offset(i, 0)
            Set MyChart = .ChartObjects.Add(グラフ範囲.Left, グラフ範囲.Top, グラフ範囲.Width, グラフ範囲.Height)
            With MyChart.Chart
　　　　　　　　　　：
　　　　　　　　　　：
            End With
        Next
    End With
 End Sub
 (Mook)

 Mook様

 回答ありがとうございました。
 グラフの作成は希望通りできたのですが、なぜか空白のグラフが余分に
 一つ作成されます。これを作成されないようにするにはどこを直したら
 いいのでしょうか？

 それからできたらもう一つ教えて頂きたいのですが、
 A1, A24と同じく23行ごとに日付が入力されており、それをグラフタイトルに
 したいのですが、この場合どのようにしたらいいのでしょうか。
 とりあえず下記のコードで1グループ目は表示できたのですが、それ以降の
 表示のさせ方がわかりません。
 .ChartTitle.Text = Worksheets("sheet1").Range("A1")

 よろしくお願いします。

 (モリ）

 数に関しては For 文の範囲を調整してください。
 グラフ範囲と同じように Offset が必要だと思います。
 (Mook)

 Mook様
 グラフの作成数はFor 文の範囲を訂正して直せました。
 ありがとうございました。

 (モリ）

コメント返信：

[ 一覧(最新更新順) ]

[[20110918073721]] 『グラフの一括作成』（モリ） ページの最後に飛ぶ

[[20110918073721]]　『グラフの一括作成』（モリ）　ページの最後に飛ぶ