| |
以前ここの質問箱でお世話になった物ですが
連続してグラフを作成するマクロです。
最近になって連続して2000個のグラフを作成しようと思い
実行したのですが、250個目辺りで
.SeriesCollection(1).XValues = r1 のところでエラーが出てしまいます。
また、一度マクロを終了しても、文字等をセルに入力しようとすると
"このブックにはこれ以上フォントを設定できません1004":というエラーが出て
しまいます。
当方Macを使用していますが、Winで実行してもグラフの個数は違いますが
エラーは出てしまいます。
Excel 2000 を使用しています。
一個目からエラーが出てしまえば原因も分かりそうなんですが
250個も作ってからなので何が原因か私には解りません。
みなさん どうぞ宜しくお願いいたします。
-------------------------------------------------------------------
Sub グラフ()
Dim co As ChartObject
Dim ws1 As Worksheet, ws2 As Worksheet
Dim r1 As Range, r2 As Range, r3 As Range
Set ws1 = ActiveSheet
Set ws2 = ws1.Parent.Worksheets.Add
'最大、Xの範囲など
With ws1
Rmax& = .Range("A1").End(xlDown).Row - 1 '列の最終行の値
Imax& = .Range("B1").End(xlToRight).Column - 1 '行の最終行の値
Set r1 = .Range(.Cells(1, 2), .Cells(1, Imax&)) 'X軸の配列
End With
For II& = 1 To Rmax& '列
With ws1
Set r2 = .Range(.Cells(1 + II&, 1), .Cells(1 + II&, Imax&))
End With
Gx = 4
Gy = 11
'グラフを描く位置(10個で折り返し)
CC% = ((II& - 1) \ 10) * Gx + 1
RR& = ((II& - 1) Mod 10) * Gy + 1
If CC% + Gx - 1 > 256 Then
MsgBox "これ以上つくれません", vbCritical, II&
Exit For
Else
With ws2
Set r3 = .Range(.Cells(RR&, CC%), _
.Cells(RR& + Gy - 1, CC% + Gx - 1))
End With
'グラフ追加
With r3
Set co = ws2.ChartObjects.Add(.Left, .Top, .Width, .Height)
End With
With co.Chart
With .ChartArea
.Border.LineStyle = xlLineStyleNone
.Interior.ColorIndex = 2
.AutoScaleFont = False
.Font.Size = 8
End With
.ChartType = xlLine
.SetSourceData Source:=r2, PlotBy:=xlLine
ここ→ .SeriesCollection(1).XValues = r1
.HasTitle = True
.HasLegend = False
.Axes(xlCategory).HasTitle = False
.Axes(xlValue).HasTitle = False
.Axes(xlValue).MajorGridlines.Border.ColorIndex = 15
.Axes(xlValue).MajorGridlines.Border.Weight = xlHairline
.Axes(xlValue).MajorGridlines.Border.LineStyle = xlContinuous
.Axes(xlCategory).TickLabels.Orientation = xlDownward
.PlotArea.Interior.ColorIndex = 2
.PlotArea.Border.LineStyle = xlNone
.ChartTitle.Text = ti
End With
End If
Next
Set co = Nothing: Set ws1 = Nothing: Set ws2 = Nothing
Set r1 = Nothing: Set r2 = Nothing: Set r3 = Nothing
End Sub
-------------------------------------------------------------------
|
|
