【VBA】レコードセットからグラフを作成

質問

Excel2002とAccess2002を使っています。

(1)Accessから取得したレコードセットをデータソースにして
　グラフを作成する事はできますでしょうか？
　（シートにレコードセットを格納せずに）
(2)上記が実現不可なら、レコードセットを配列に代入し、
　その配列をデータソースにしてグラフを作成する事はできますでしょうか？

レコードセットを一度シートに吐き出す事は考えていません。
(1)、(2)とも具体的なコードを書いて頂けると助かります。
よろしくお願いします。

回答No.7

mitarashi · ベストアンサー

#6の対策を取る前は、質問者様が補足に書かれた様な状況でした。
このとき名前"Date"の内容は、下記の様なものでした。文字列として入っています。
={"1/1/2010";"1/2/2010";"1/3/2010";"1/4/2010";"1/5/2010";"1/6/2010";"1/7/2010";"1/8/2010";（以下略）
やむを得ず、倍精度浮動小数点数に変換した後は、下記の様な形でした。
={40179;40180;40181;40182;40183;40184;40185;40186;40187;4（以下略）
この状態で、軸の書式を日付形式にすると、所期の日付で表示されました。
当方xl2000（xl2010は検証用にしか使えていない－使いこなしていない）ですが、下記コードで日付表示されております。

Sub test()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim SQL As String
Dim chart1 As Chart
Dim i As Long
Dim arrayX As Variant
Dim arrayY As Variant

Set cn = New ADODB.Connection
cn.Provider = "Microsoft.Jet.OLEDB.4.0"
cn.Open ThisWorkbook.Path & "\db1.mdb"
SQL = "SELECT TOP 1000 * FROM Table1 ORDER BY ID;"
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open SQL, cn, adOpenStatic, adLockReadOnly
With Worksheets(1)
arrayX = .Range(.Cells(1), .Cells(rs.RecordCount, 1))
arrayY = .Range(.Cells(1), .Cells(rs.RecordCount, 1))
End With
For i = 1 To rs.RecordCount
arrayX(i, 1) = CDbl(rs.Fields(1))
arrayY(i, 1) = rs.Fields(2)
rs.MoveNext
Next i
ThisWorkbook.Names.Add Name:="Date", RefersTo:=arrayX
ThisWorkbook.Names.Add Name:="Rate", RefersTo:=arrayY
Set chart1 = Charts.Add(Before:=ActiveSheet)
chart1.ChartType = xlXYScatter
chart1.SeriesCollection.NewSeries
With chart1.SeriesCollection(1)
.XValues = "='" & ThisWorkbook.Name & "'!Date"
.Values = "='" & ThisWorkbook.Name & "'!Rate"
End With
chart1.Axes(xlCategory).TickLabels.NumberFormatLocal = "yyyy/m/d"
Set rs = Nothing
Set cn = Nothing
End Sub

お礼

mitarashi様

勘違いしていました！申し訳ございません…
>>arrayX(i, 1) = CDbl(rs.Fields(1)) 'ここでDatevalueにしてもダメ
の部分を勘違いしていてスルーしていました…
コードにCDblを入れて実行したところ
問題なく期待した日付が出てきました。
この度は最後までお付き合い頂き本当にありがとうございました。
mitarashi様は真のハッカーです。（もちろん良い意味の方の）
私も精進致します。

回答No.6

mitarashi

#2～5ですが、また出てくるはめになりました．．．
出来たことに満足してグラフを眺めていると、なんだか変
X軸が日付になっていない。
色々やってみましたが、
レコードセットから配列に取り込む際に、数値に変換し、
For i = 1 To rs.RecordCount
arrayX(i, 1) = CDbl(rs.Fields(1)) 'ここでDatevalueにしてもダメ
arrayY(i, 1) = rs.Fields(2)
rs.MoveNext
Next i
グラフの目盛りの表示形式を日付形式にしないと、うまく行かない様です。
chart1.Axes(xlCategory).TickLabels.NumberFormatLocal = "yyyy/m/d"
日付のままだと、「名前」に入れる際に、文字列に変えられてしまうみたいです。
ご参考まで。

お礼

mitarashi様

改めてこんなに調べて頂いて本当にありがとうございました。
またお返事が遅くなってしまって申し訳ありません…
書いて頂いたコードを実行してみました。

XValueに日付を入れたのですが、
出来上がったグラフを見てみると
2001年から2010年まで日付が入るグラフが
すべて1900年代になってしまっていました…
おそらく要素の数がX軸になってしまっているのだと思われます…
配列の行と列を入れ替えたりRedimしてみたり
!Dateの後に記号や数字を入れたりしてみましたが
現象変わらずです…
もしかしたら私の環境に依存するかもしれません。
mitarashi様の方はどのような感じでしょうか？

回答No.5

mitarashi

#4です。たびたびすみません。

>動的配列の一次元目をredimする代用、セル値は上書きしてしまう

誤解を招きそうですが、読み込んだセルの値は、後ほどレコードセットの値で上書きしてしまうので、関係ありませんと言いたかったものです。補足させていただきます。

回答No.4

mitarashi

#2,3です。それでもと思ってやってみました。
Excel固有機能に相当お世話になっておりますが、シートに書き出してはいません．．．
当然ながら、別のグラフを描くときは、別の範囲名をつけないと、先ののグラフも変わってしまいます。
Sub test()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim SQL As String
Dim chart1 As Chart
Dim i As Long
Dim arrayX As Variant
Dim arrayY As Variant

Set cn = New ADODB.Connection
cn.Provider = "Microsoft.Jet.OLEDB.4.0"
cn.Open ThisWorkbook.Path & "\db1.mdb"
SQL = "SELECT TOP 1000 * FROM Table1 ORDER BY ID;"
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open SQL, cn, adOpenStatic, adLockReadOnly
'動的配列の一次元目をredimする代用、セル値は上書きしてしまう
With Worksheets(1)
arrayX = .Range(.Cells(1), .Cells(rs.RecordCount, 1))
arrayY = .Range(.Cells(1), .Cells(rs.RecordCount, 1))
End With
For i = 1 To rs.RecordCount
arrayX(i, 1) = rs.Fields(1)
arrayY(i, 1) = rs.Fields(2)
rs.MoveNext
Next i
ThisWorkbook.Names.Add Name:="Date", RefersTo:=arrayX
ThisWorkbook.Names.Add Name:="Rate", RefersTo:=arrayY
Set chart1 = Charts.Add(Before:=ActiveSheet)
chart1.ChartType = xlXYScatter
chart1.SeriesCollection.NewSeries
With chart1.SeriesCollection(1)
.XValues = "='" & ThisWorkbook.Name & "'!Date"
.Values = "='" & ThisWorkbook.Name & "'!Rate"
End With
Set rs = Nothing
Set cn = Nothing
End Sub

参考URL：

http://blogs.yahoo.co.jp/mikezang/59251225.html

回答No.3

mitarashi

#2です。
まず、GetRowsは100レコード以上はダメな様です。
http://support.microsoft.com/kb/198528/en-us/
（機械翻訳の日本語版は英語以上に訳が分かりませんでした）
それではと、下記のコードでやってみましたが、別の制限がある様です。
http://blogs.yahoo.co.jp/mikezang/59251225.html
http://okwave.jp/qa/q4398916.html

下記コードのTOP 20のところをいろいろ振ってみましたが、
Excel2000は21からエラーになりました。
Excel2010は、999でもエラーになりませんでした。（1000個のつもりが一個足りなかった）
互換モードではなく、形式を変換した後の話です。
参考URLにある、SEREIS formula 256文字の制限（256列の制限を反映）は妥当な様です。
二つめの参考URLのコード4はメモリー上でやっている様ですが、
ここまで頑張ってメモリー上でやる必要があるのかな？と思います。
なお、Application.Transpose等も試してみましたが、ダメでした。

Sub test()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim SQL As String
Dim chart1 As Chart
Dim i As Long
Dim arrayX() As Date
Dim arrayY() As Double

Set cn = New ADODB.Connection
cn.Provider = "Microsoft.Jet.OLEDB.4.0"
cn.Open ThisWorkbook.Path & "\db1.mdb"
SQL = "SELECT TOP 20 * FROM Table1 ORDER BY ID;"
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open SQL, cn, adOpenStatic, adLockReadOnly
ReDim arrayX(rs.RecordCount - 1)
ReDim arrayY(rs.RecordCount - 1)
For i = 0 To rs.RecordCount - 1
arrayX(i) = rs.Fields(1)
arrayY(i) = rs.Fields(2)
rs.MoveNext
Next i
Set chart1 = Charts.Add(Before:=ActiveSheet)
chart1.ChartType = xlXYScatter
chart1.SeriesCollection.NewSeries
With chart1.SeriesCollection(1)
.XValues = arrayX
.Values = arrayY
End With
Set rs = Nothing
Set cn = Nothing
End Sub

お礼

こんなに調べて頂き本当にありがとうございますm(_ _)m
とてもお手数お掛けしてしまい非常に恐縮です…
私の方で今時間があまり取れない状態なので
恐れながらまた改めて書き込みさせて頂きます。

回答No.2

mitarashi

#1さんの仰る通りで、エクセルを使いながら、メモリ上に拘る意味が解りかねますが、
興味のおもむくまま調べてみました。一つ利口になりました。
エクセルからmdbにアクセスしています。
'ADOに参照設定要
Sub test()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim SQL As String
Dim chart1 As Chart

Set cn = New ADODB.Connection
cn.Provider = "Microsoft.Jet.OLEDB.4.0"
cn.Open ThisWorkbook.Path & "\db1.mdb"
SQL = "SELECT * FROM Table1;"
Set rs = New ADODB.Recordset
rs.Open SQL, cn, adOpenStatic, adLockReadOnly
If rs.BOF Then Exit Sub
Set chart1 = Charts.Add(Before:=ActiveSheet)
chart1.SeriesCollection.NewSeries
'試験用データTable1のFields(0)はIDなので、Fields(1)から指定しています
With chart1.SeriesCollection(1)
.XValues = rs.GetRows(, , rs.Fields(1))
rs.MoveFirst
.Values = rs.GetRows(, , rs.Fields(2))
End With
Set rs = Nothing
Set cn = Nothing
End Sub

補足

回答ありがとうございます。
メモリ上に拘る理由は、メモリ上で処理できれば
シートに書き出す必要がないのでは、、というただの好奇心です。
書いた頂いたコードを実行してみましたところ
ずっとエラーが出て悩んでいたのですが、
どうやらレコードセットの行数に関係していたようです。
１００件以上のレコードセットで試してみたところ
.Values = rs.GetRows(, , rs.Fields(2))の行で
実行時エラー　1004
アプリケーション定義またはオブジェクト定義のエラーです
というエラーが出ます。
（たまに違うエラーも出たような…）
４件のレコードセットで試してみたところ、
問題なく実行できました。

実は作りたいグラフが１００件以上のレコードを持つ
X軸に日付が入り、Y軸に4種のDoubleが入るものでして…
（ちなみにテストしたのはまた別のテーブルです…）
１００件以上のデータも問題なく実行するにはどうしたら良いでしょうか…？m(_ _)m

回答No.1

ichhabehunger

こんにちは。

なぜシートにデータを吐き出してはいけないのか、
その理由を明確にすべきでしょう。
単に自分の希望を言うだけではだめです。
あなたの努力は？　って言われます。

VBAで行うなら一度シートにデータを吐き出したって
何の問題もないはずです。
グラフだけ作って画像で固定してあとは
もとになったシートをさっさと消してしまう
ってことはできないでしょうか？

当方、コードを書くつもりは毛頭ありません。
コードもらいならそれに答えるつもりはありません。