|
いつもお世話になっております。
また、作図について教えていただきたくお願いします。
グラフの書き換え用に以下のマクロを作成しましたが、作業が重くどうにかしたいと思っています。具体的には※1でグラフをアクティブにせずに作図できるのか?次に※2で一度線を描いてから線種の書式設定をしている2度手間を整理できないかということになります。
また、削除マクロの※3で系統名が""の場合の処理をしていますが、実際にはエラーでとまってしまいます。
まとまりのない質問ですが、ご回答宜しくお願いします。
Sub 描画()
Dim i As Integer
Dim j As Integer
Dim k As Double
Dim l As Double
Dim m As Double
ActiveSheet.ChartObjects("グラフ 5").Activate ※1
j = 10
i = ActiveChart.SeriesCollection.Count + 1
k = Worksheets("DATA").Range("F5").Value
l = Worksheets("DATA").Range("F4").Value
m = Worksheets("DATA").Range("E4").Value + k
While m < l
ActiveChart.SeriesCollection.NewSeries ※2
With ActiveChart.SeriesCollection(i)
.XValues = "=DATA!R" & j & "C48:R" & j & "C49"
.Values = "=DATA!R" & j & "C50:R" & j & "C51"
.Name = "x_" & m
.Border.ColorIndex = 1
.Border.Weight = xlHairline
.Border.LineStyle = xlContinuous
End With
i = i + 1
j = j + 1
m = m + k
Wend
End Sub
Sub 削除()
Dim i As Integer
Dim j As Integer
Dim l As String
ActiveSheet.ChartObjects("グラフ 5").Activate
i = ActiveChart.SeriesCollection.Count
While i > 1
If ActiveChart.SeriesCollection(i).Name = "" Then l = "xx" _
Else l = Left(ActiveChart.SeriesCollection(i).Name, 2) ※3
If l = "x_" Then ActiveChart.SeriesCollection(i).Delete
i = i - 1
Wend
End Sub
|
|