Access VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

1892 / 9994

←次へ　｜　前へ→


	【11384】Re:フォームで抽出したデータをExcel出力

小僧 - 10/1/15(金) 10:20 -


	引用なし

	パスワード

▼ＶＢＡ初心者さん：
こんにちは。

>「acExport, 8,」の部分が解釈できません。

TransferSpreadsheet のヘルプはご覧になられましたか？
（Accessのヘルプではなく、VBAのヘルプですね）

英語のページしか見つかりませんでしたが
MSの

h tp://msdn.microsoft.com/en-us/library/bb225982.aspx
MSのサイトにもありますね。

> エクセルのセル内に綺麗に収まり画面にデータが出力されます。
>　TransferSpreadsheetを使っても同じように出力できますでしょうか。

Output To メソッドも TransferSpreadsheet も
お手軽にExcelへの出力を行ってくれる半面
今回の様に細かく書式やセルの大きさを設定できない
欠点もあります。

以前に

>> Output To メソッドを使った後に書式を変更する事も可能ですが
>> ExcelVBAとオートメーションの知識が必要となってきます。

と回答させて頂きましたが、
オートメーションを使う必要がありそうですね。

Private Sub コマンド35_Click()
Dim DB As DAO.Database
Dim RS As DAO.Recordset
Dim strSQL As String
Dim strWhere As String
Dim xlsApp As Object
Dim xlsWkb As Object
Dim xlsFileName As String
Dim i As Long

　　'フィルタを掛けた時点で Hitするものがなかったような場合は
　　'メッセージを出して処理を中止します。
　　If Me.Recordset.EOF Then
　　　　MsgBox Prompt:="出力するデータがありませぬ" _
　　　　　　 , Buttons:=vbExclamation
　　　　Exit Sub
　　End If

　　Set DB = CurrentDb
　　xlsFileName = "C:\" & Format(Date, "yyyy_mm_dd") & "ホストデータ.xls"
　　
　　'もし Filterプロパティになにも記述されていなかったら
　　'フォームに表示されている全データを出力するようにします。
　　
　　If Me.Filter = "" Then
　　　　strWhere = True
　　Else
　　　　strWhere = Me.Filter
　　End If

　　
　　'変数に SQL文を代入します。
　　'Filter プロパティに記述されているものを抽出条件とします。
　　
　　strSQL = ""
　　strSQL = strSQL & " SELECT 登録日 "
　　strSQL = strSQL & "　　　, QH_COMM AS 事業所 "
　　strSQL = strSQL & "　　　, NEW_HOSTNAME AS 新ＰＣ名 "
　　strSQL = strSQL & "　　　, QH_IPADR AS IPアドレス "
　　strSQL = strSQL & "　　　, MEMO2 AS メモ１ "
　　strSQL = strSQL & "　　　, MEMO3 AS メモ２ "
　　strSQL = strSQL & "　　　, MEMO4 As メモ３ "
　　strSQL = strSQL & "　　　, MEMO5 As 事項 "
　　strSQL = strSQL & " FROM " & Me.RecordSource & " "
　　strSQL = strSQL & " WHERE " & strWhere

　　'レコードセットに対象のデータを代入します
　　Set RS = DB.OpenRecordset(strSQL, dbOpenSnapshot)
　　　　
　　'以下Excelの操作------------------------------------------
　　Set xlsApp = CreateObject("Excel.Application")
　　　　xlsApp.Visible = True
　　
　　Set xlsWkb = xlsApp.workbooks.Add
　　　　With xlsWkb.Sheets("Sheet1")
　　　　
　　　　For i = 0 To RS.Fields.Count - 1
　　　　　　.Range("A1").Offset(0, i).Value = RS.Fields(i).Name
　　　　Next i
　　　　
　　　　.Range("A2").CopyFromRecordset RS
　　　　.Columns("A:H").AutoFit
　　　　End With
　　　　
　　　　xlsWkb.SaveAs xlsFileName
　　xlsWkb.Close: Set xlsWkb = Nothing
　　xlsApp.Quit:　Set xlsApp = Nothing
　　
　　MsgBox "出力が終了しました"
　　　　
End Sub

ご参考になれば幸いです。

1,601 hits

▼

【11370】フォームで抽出したデータをExcel出力 ＶＢＡ初心者 10/1/12(火) 17:04