DataGridコントロールのデータのコピー

質問

いつもお世話になっております。

VisudalBasic6の開発環境で
Microsoft DataGrid Control(SP6)のDataGridコントロールを使用して、
Oracleデータベースから得られたテーブルのデータを表示させているのですが、
DataGridコントロールに表示されたすべてのデータをコピーし、エクセルなどにペーストすることはできないでしょうか？

方法をご存知の方おられましたらご教授願えないでしょうか？

回答No.4

piroin654 · ベストアンサー

DataGrid1の親オブジェクトをくっつけたので
実際に合わせて変更してください。親をForm1としています。
縦スクロールバーを動かしてデータを見えるようにしました。

Private Sub Command1_Click()
Dim h As Long
Dim i As Long
Dim j As Long
Dim exlApp As Workbook
Dim strFile As String
Dim lnRow As Long
Dim lnCol As Long

'パス
strFile = "C:\test\5\myAAA.xls"
Set exlApp = GetObject(strFile, "Excel.Sheet")

'ヘッダのコピペ
For h = 0 To Form1.DataGrid1.Columns.Count - 1
exlApp.Worksheets("sheet1").Cells(1, h + 1) = Form1.DataGrid1.Columns(h).Caption
Next h

'データのコピペ
j = 1
Do While Form1.DataGrid1.Row <= Form1.DataGrid1.VisibleRows - 1
For i = 0 To Form1.DataGrid1.Columns.Count - 1
Form1.DataGrid1.Col = i
exlApp.Worksheets("sheet1").Cells(j + 1, i + 1).Value = Form1.DataGrid1.Text
Next
j = j + 1
If Form1.DataGrid1.Row < Form1.DataGrid1.VisibleRows - 1 Then
Form1.DataGrid1.Row = Form1.DataGrid1.Row + 1
Else
Exit Do
End If
Loop

exlApp.Windows(1).Visible = True
exlApp.Save
exlApp.Application.Quit
Set exlApp = Nothing
End Sub

お礼

教えていただいたソースを元に
以下のソースを作りました。

Private Sub Command1_Click()

　　Dim i As Long
　　Dim j As Long
　　Dim h As Long
　　Dim strFile As String

　　On Error Resume Next

　　CommonDialog1.Filter = "CSVファイル(*.CSV)|*.CSV"
　　CommonDialog1.ShowSave

　　'ヘッダのコピペ
　　For h = 1 To DataGrid1.Columns.Count - 1
　　　　If strFile = vbNullString Then
　　　　　　strFile = DataGrid1.Columns(h).Caption
　　　　Else
　　　　　　strFile = strFile + "," + DataGrid1.Columns(h).Caption
　　　　End If
　　Next h

　　strFile = strFile + vbCrLf

　　j = 1

　　Do While Form1.DataGrid1.Row <= Form1.DataGrid1.VisibleRows - 1
　　　　For i = 1 To Form1.DataGrid1.Columns.Count - 1
　　　　　　Form1.DataGrid1.Col = i
　　　　　　If i = 1 Then
　　　　　　　　strFile = strFile + DataGrid1.Text
　　　　　　Else
　　　　　　　　strFile = strFile + "," + DataGrid1.Text
　　　　　　End If
　　　　Next

　　　　j = j + 1

　　　　strFile = strFile + vbCrLf
　　　　If Form1.DataGrid1.Row < Form1.DataGrid1.VisibleRows - 1 Then
　　　　　　Form1.DataGrid1.Row = Form1.DataGrid1.Row + 1
　　　　Else
　　　　　　Exit Do
　　　　End If
　　Loop

　　Dim fileNo As Integer
　　fileNo = FreeFile
　　Open CommonDialog1.FileName For Output As #fileNo
　　Print #fileNo, strFile;

End Sub

エクセルシートに書き込むと動作が重くなるため、CSV形式での出力にしました。
無事に表データをすべて出力することができ、本当に助かりました。
有難う御座いました。

回答No.5

piroin654

No4の変数宣言で、
Dim lnRow As Long
Dim lnCol As Long
の二つは使っていないので削除してください。

回答No.3

piroin654

No2です。参照設定で
Microsoft Excel xx Object Library
にチェックを入れておいてください。

補足

回答有難う御座います。

教えていただいたソースコードを使い、実行しましたが、
ボタンを押した瞬間に、DataGridで表示されている範囲のデータしか正常に出力されず、それ以降のデータは、全て同じデータとなります。
具体的には、18行を表示させており、縦スクロールバーを使っています。
出力されるデータは、1～18行で19行目以降は18行目と同じデータになります。

回答No.2

piroin654

ADOとレコードセットを利用する方法も
ありますが、以下でどうですか。

Private Sub Command1_Click()

Dim h As Long
Dim i As Long
Dim j As Long
Dim exlApp As Workbook
Dim strFile As String

'パス
strFile = "C:\test\5\myAAA.xls"
Set exlApp = GetObject(strFile, "Excel.Sheet")

'ヘッダのコピペ
For h = 0 To DataGrid1.Columns.Count - 1
exlApp.Worksheets("sheet1").Cells(1, h + 1) = DataGrid1.Columns(h).Caption
Next h
'データのコピペ
For i = 0 To DataGrid1.ApproxCount - 1
DataGrid1.Row = i
For j = 0 To DataGrid1.Columns.Count - 1
exlApp.Worksheets("sheet1").Cells(i + 2, j + 1).Value = DataGrid1.Columns(j).Text
Next j
Next i

exlApp.Windows(1).Visible = True
exlApp.Save
exlApp.Application.Quit
Set exlApp = Nothing

End Sub

回答No.1

MARU4812

Clipboard クラス
http://msdn.microsoft.com/ja-jp/library/system.windows.forms.clipboard.aspx
を使ってみるとか。