スポンサーサイト 


上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

Excel へのデータ転記 


Excel を起動して、Access からデータを転記する方法には、CopyFromRecordset がある意味楽ですね。
CopyFromRecordset 以外に手頃のものがあるか・・・・これをチョッとやってみます。

Recordset rs を得ておいて、レコードごとに
Cells(x,y) = rs(0) とか・・・・これはこれで用途はありますけど・・・・

Recordset のメソッドに GetRows がありますね。
これを使ってみます。

以下の内容でテーブル「T1」が出来上がっているものとします。
an氏名日付金額
1AAAA2013/04/01¥4,010 
2BBBB2013/04/02¥420 
3CCCC2013/04/03¥4,030 
4DDDD2013/04/04¥44 
501232013/05/01¥510 
622222013/05/03¥530 
an : オートナンバ ・ 氏名:テキスト型 ・ 日付:日付/時刻型 ・ 金額:通貨

パターン1

以下の記述で Excel 出力してみます。
Public Sub test1()
  Dim rs As New ADODB.Recordset
  Const xlContinuous = 1

  rs.Open "T1", CurrentProject.Connection, adOpenStatic, adLockReadOnly
  If (Not rs.EOF) Then
    With CreateObject("Excel.Application")
      .Workbooks.Add
      .Range("A1:E20").Borders.LineStyle = xlContinuous
      .Range("A2").CopyFromRecordset rs
      rs.MoveFirst
      .Range("A11").Resize(rs.RecordCount, rs.Fields.Count) = _
                  .WorksheetFunction.Transpose(rs.GetRows)
      .Visible = True
    End With
  End If
  rs.Close
End Sub

まず、A1:E20 に罫線を引いておきます。
A2 から CopyFromRecordset でデータを出力します。
CopyFromRecordset 後は、EOF = True となるので、GetRows 前に MoveFirst しておきます。
rs.GetRows では Variant の2次元配列でデータが得られるのですが、行・列 の並びが Excel と逆・・・・
なので、Transpose を使って入れ替えたものを設定します。

これの出力結果は、(左:Vista+2007 右:Win2k+2000)(XpPro+2003は全て2007と同じでした)
以降、図の表示は・・・・左:2007 右:2000 となります。

kEnt163_1  kEnt163_2000_1

※ 見え方の違いは、ソコソコありますが、細かく取り上げません。
結構、CopyFromRecordset と GetRows での表示に違いがありますね。

という事で、以降パターン2~パターン4やってみます。
 
パターン2

パターン1での表示で、GetRows した表示が意図した通りでは無さ過ぎるので・・・・
GetRows の値を一度 v 変数に生成し・・・それぞれのデータの型を A21 以降に表示してみる事に

Public Sub test2()
  Dim rs As New ADODB.Recordset
  Dim v As Variant
  Dim i As Long, j As Long
  Const xlContinuous = 1

  rs.Open "T1", CurrentProject.Connection, adOpenStatic, adLockReadOnly
  If (Not rs.EOF) Then
    With CreateObject("Excel.Application")
      .Workbooks.Add
      .Range("A1:E30").Borders.LineStyle = xlContinuous
      .Range("A2").CopyFromRecordset rs
      rs.MoveFirst
      v = rs.GetRows
      .Range("A11").Resize(UBound(v, 2) + 1, UBound(v, 1) + 1) = _
                  .WorksheetFunction.Transpose(v)
      For i = 0 To UBound(v, 1)
        For j = 0 To UBound(v, 2)
          v(i, j) = TypeName(v(i, j))
        Next
      Next
      .Range("A21").Resize(UBound(v, 2) + 1, UBound(v, 1) + 1) = _
                  .WorksheetFunction.Transpose(v)
      .Visible = True
    End With
  End If
  rs.Close
End Sub

これでの表示は以下の様になります。

kEnt163_2  kEnt163_2000_2

Variant に生成された型はおかしくはなさそう・・・・
でも、「金額」部分の表示は、なんで左詰め???
v 内の値には ¥ なんて入ってないのに・・・

パターン3

じゃ、データを設定する前に、各列の書式を設定してからやってみましょうか・・・・

Public Sub test3()
  Dim rs As New ADODB.Recordset
  Dim v As Variant
  Dim i As Long, j As Long
  Const xlContinuous = 1

  rs.Open "T1", CurrentProject.Connection, adOpenStatic, adLockReadOnly
  If (Not rs.EOF) Then
    With CreateObject("Excel.Application")
      .Workbooks.Add
      .Range("A1:E30").Borders.LineStyle = xlContinuous
      With .Range("A1")
        For i = 0 To rs.Fields.Count - 1
          Select Case rs.Fields(i).Type
            Case adInteger
              .Offset(, i).EntireColumn.NumberFormatLocal = "0_ "
            Case adCurrency
              .Offset(, i).EntireColumn.NumberFormatLocal = "\#,##0;\-#,##0"
            Case adDate
              .Offset(, i).EntireColumn.NumberFormatLocal = "yyyy/mm/dd"
            Case adVarWChar
              .Offset(, i).EntireColumn.NumberFormatLocal = "@"
          End Select
        Next
      End With
      .Range("A2").CopyFromRecordset rs
      rs.MoveFirst
      v = rs.GetRows
      .Range("A11").Resize(UBound(v, 2) + 1, UBound(v, 1) + 1) = _
                  .WorksheetFunction.Transpose(v)
      For i = 0 To UBound(v, 1)
        For j = 0 To UBound(v, 2)
          v(i, j) = TypeName(v(i, j))
        Next
      Next
      .Range("A21").Resize(UBound(v, 2) + 1, UBound(v, 1) + 1) = _
                  .WorksheetFunction.Transpose(v)
      .Visible = True
    End With
  End If
  rs.Close
End Sub

これでやった結果が以下

kEnt163_3  kEnt163_2000_3

やっぱり、GetRows した「金額」部分が左詰め・・・・
ん~~~~なんだろ・・・
あれ、CopyFromRecordset での日付部分は、設定した書式は使われないの???
(2000 ではチャンとなってたね)

パターン4

じゃ・・・単純な代入(設定)もしてみますか・・・・

Public Sub test4()
  Dim rs As New ADODB.Recordset
  Dim v As Variant
  Dim i As Long, j As Long
  Const xlContinuous = 1

  rs.Open "T1", CurrentProject.Connection, adOpenStatic, adLockReadOnly
  If (Not rs.EOF) Then
    With CreateObject("Excel.Application")
      .Workbooks.Add
      .Range("A1:E40").Borders.LineStyle = xlContinuous
      With .Range("A1")
        For i = 0 To rs.Fields.Count - 1
          Select Case rs.Fields(i).Type
            Case adInteger
              .Offset(, i).EntireColumn.NumberFormatLocal = "0_ "
            Case adCurrency
              .Offset(, i).EntireColumn.NumberFormatLocal = "\#,##0;\-#,##0"
            Case adDate
              .Offset(, i).EntireColumn.NumberFormatLocal = "yyyy/mm/dd"
            Case adVarWChar
              .Offset(, i).EntireColumn.NumberFormatLocal = "@"
          End Select
        Next
      End With
      .Range("A2").CopyFromRecordset rs
      rs.MoveFirst
      v = rs.GetRows
      .Range("A11").Resize(UBound(v, 2) + 1, UBound(v, 1) + 1) = _
                  .WorksheetFunction.Transpose(v)
      With .Range("A21")
        For j = 0 To UBound(v, 2)
          For i = 0 To UBound(v, 1)
            .Offset(j, i) = v(i, j)
          Next
        Next
      End With

      For i = 0 To UBound(v, 1)
        For j = 0 To UBound(v, 2)
          v(i, j) = TypeName(v(i, j))
        Next
      Next
      .Range("A31").Resize(UBound(v, 2) + 1, UBound(v, 1) + 1) = _
                  .WorksheetFunction.Transpose(v)
      .Visible = True
    End With
  End If
  rs.Close
End Sub

この結果が以下になります。

kEnt163_4  kEnt163_2000_4

ん~~~
バージョンによっていろいろあるんですかね??

確実なのは、書式を設定後に1つ1つ Cells(x,y) = rs(0) とかでしょうかね??


ご自分の環境でいろいろと動かしてみてください。
サンプルファイルには、テーブル「T1」と標準モジュール「Module1」しか入ってません。
「Module1」内の各 test1 ~ test4 を直接実行してみてください。

2000 と 2003/2007 は結果が結構違いますが、2000 の方が対処しやすいような・・・素直なような・・・


サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt163_2000.zipkEnt163_2003.zipkEnt163_2007.zip
 サイズ 18,00418,60419,869
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化

関連記事

2013/05/28

Category: やってみる

TB: --  /  CM: 0

top △

この記事に対するコメント

top △

コメントの投稿

Secret

top △


上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。