Access：データシート形式表示のフォームをそのままExcelへ

質問

Access2003　WinXPです。
フォームにサブフォームを置き、クエリで抽出したデータを
データシート形式で表示しているフォームをサブフォームへ表示させています。
この、サブフォーム、またはデータシート形式のフォームをまるっと新規Excelへエクスポートしたいのですが、うまくいきません。
クエリをエクスポートは出来ますが、ユーザーがサブフォームに表示されたデータのフィールドを入れ替えて、その見た目のまま出力したいという希望があるので。。。
分かる方いらっしゃいましたら、宜しくお願いします。

回答No.6

30246kiku · ベストアンサー

＃５です

mdb 見させていただきました。

> Fsub.Setfocus の後のレコード選択でエラーです。
> コマンドまたはアクション‘すべてのレコードの選択’は無効です。

これは確認できませんでした（変更なし状態にて）
（以下のタイミングが関係しているのかも？）

> それ以前にレコードの選択が出来なくて困っています；

条件指定したものがサブフォームに表示されないということでしょうか。
であれば、再現できませんでした（変更なし状態にて）

また、更新/削除/追加ができないということであれば、
サブフォームをデザインビューで開き、プロパティ・更新/削除/追加の許可を変更してみてください。

Excel出力時、私の環境では、セル１つにのみ「ID」値が表示されただけでした。
(2003 + XP Pro)
これは、タイミング的なものと思われます。

　　　　Dim oApp As Object
　　　　Set oApp = CreateObject("Excel.Application")
　　　　oApp.Workbooks.Add
　　　　oApp.Visible = True　' ★

上記★部分をコメントにしてください。

Excelの表示化（True）とコピー（ペースト）処理が重なった様な雰囲気です。
（詳細はわかりません）

　　　　oApp.Columns.EntireColumn.AutoFit
　　　　oApp.Visible = True

処理が終わったところで表示すればよいことなので、最後のところだけを有効（そのまま）とします。

私が変更したのは、★のところだけです。

確認してみてください。
また補足してください。

お礼

回答ありがとうございます。
出来ました！目で確認しながら、と思って早めにVisible=Trueにしていましたが、それが影響していたとは！びっくりです。
実現できて感激です。ありがとうございました！！

回答No.5

30246kiku

＃３です

＃２さん、ありがとうございます。

小さいのをコピーしていったとして、何か個数制限???があるような雰囲気もあります。
（2003ではExcelでOfficeクリップボード、2007ではツールバーのクリップボードをみると
1/24 の様に 24 が気になります）

私もあの方法が使いたかったので、時間作ってクリップボード関係のものを見てみました。
あのクリップボードからのメッセージを出させない＝クリップボードを空にすれば、、
と考え、以下の方法で動いているようにみえます。

但し、クリップボードに何個か入れていて、Accessを終了後も使いたい、ってことなら、その操作はできなくなります。
（Excelに貼り付けたら、クリップボードを空にするので）

標準モジュールに以下を記述します。

Private Declare Function apiOpenClipboard Lib "User32" _
　　　　　　　　　　Alias "OpenClipboard" (ByVal hWnd As Long) As Long
Private Declare Function apiCloseClipboard Lib "User32" _
　　　　　　　　　　Alias "CloseClipboard" () As Long
Private Declare Function apiEmptyClipboard Lib "User32" _
　　　　　　　　　　Alias "EmptyClipboard" () As Long

Public Sub ClearCopyData()
　　If (apiOpenClipboard(0) <> 0) Then
　　　　Call apiEmptyClipboard
　　　　Call apiCloseClipboard
　　End If
End Sub

で、処理の方に

　　DoCmd.RunCommand acCmdCopy

　　oApp.Activesheet.Paste
　　Call ClearCopyData　' ★
　　oApp.Columns.EntireColumn.AutoFit

★部分追加で、クリップボードをクリアするようにしてみました。

ColumnOrder が同じ数値になるタイミングがありました。
何か処理が抜けているかもしれません。

> q_kekkaはあっているのですが、これを表示させているSub_Aがクエリそのままではないのです。。。
> Fsubを直接選択するのと、Sub_Aとでは違うのでしょうか。

ごめんなさい。
イメージできていないです。

サンプルと、どのあたりが異なりますか。

実際にはこの部分でこういう処理していて、、、とか指摘いただければと思います。
（サンプルがわかりにくければ、いくらでも補足しますので、、、）

補足

＞
実際にはこの部分でこういう処理していて、、、とか指摘いただければと思います。

ありがとうございます。

Fsub.Setfocus の後のレコード選択でエラーです。
コマンドまたはアクション‘すべてのレコードの選択’は無効です。
となります。
サブフォームに読み込んでいるフォームを開いてみたりしましたが関係なかったようで。。。
クエリを見るとちゃんとなっているのですが、サブフォームに読み込んでいるデータは古いままのようです。
それ以前にレコードの選択が出来なくて困っています；
クエリをExcelへ出せば早いのですが、（ユーザー希望により）IDは表示せず、列の入れ替えをしたままEXCELへ…という動きをしたいので、
サブフォームの左上四角部分をコピペ状態が一番理想なのですが。。。
何だかめちゃくちゃですみません。

回答No.4

bonaron

#3 さん
「クリップボードにコピーされているデータが多すぎます」
が表示されないようにするには、
Paste したあとで
より小さなデータをダミーでコピーすればよいです。

　　Me.テキスト1.SetFocus
　　DoCmd.RunCommand acCmdCopy
とか。

回答No.3

30246kiku

＃１です。

＃２さん、ありがとうございます。
私は、１つ賢くなったような気がします。（確かに賢くなったと思います）
データシートでない時にも使えるみたいです。

でも、コピー＆ペーストを繰り返すと、システム側から文句メッセージが出ませんか？
コピーした容量だとか、なんだかんだが多いみたいな。
（操作途中とか、Access終了時とか）

これらの警告メッセージを抑止するにはどうしたらよいのでしょうか。
ちょっと時間が取れないので、こんな感じで解消できる、とかあれば助かります。

こっちの方がExcel表示まで速いし、使っていきたいと思える方法でした。

私のわがままですが、よろしくお願いいたします。

補足

あちらこちらにすみません。
30246kikuさんの質問とは違うのですが、まるっとコピペのVBAを試してみたところ結果がおかしく、サブフォームに表示させているデータシート型のフォームに表示されているデータがおかしい事が分かりました。
ややこしいのでメインのフォームを　Main
サブフォーム名を　Fsub
Fsubに表示させているデータシート型のフォームを　Sub_A
クエリを　q_Kekka
とします。
q_kekkaはあっているのですが、これを表示させているSub_Aがクエリそのままではないのです。。。
画面上から、MainフォームのFsubの左上の四角部分を直接クリックして全選択常態にしてコピーしてExcelへ貼り付けると、Fsubそのままのデータが貼り付けられます。
でもVBAでMe.FSub.SetFocus後、
DoCmd.RunCommand acCmdSelectAllRecords
DoCmd.RunCommand acCmdCopy
すると違うデータが。。。
Fsubを直接選択するのと、Sub_Aとでは違うのでしょうか。
分かりにくい説明ですみません；分かる点ございましたらお願い致します；

回答No.2

bonaron

#1 さんの
> データシートの左上四角部分をクリックしてコピー、Excelシート上で貼り付け、
> の方が確かかと思います。（項目部分がわかりやすい表示になるとか）

これを VBA で実現してみました。

Private Sub コマンド1_Click()
　　　　Dim oApp As Object
　　　　Set oApp = CreateObject("Excel.Application")
　　　　oApp.Workbooks.Add

　　　　Me.サブフォーム名.SetFocus
　　　　DoCmd.RunCommand acCmdSelectAllRecords
　　　　DoCmd.RunCommand acCmdCopy

　　　　oApp.activesheet.Paste
　　　　oApp.Columns.EntireColumn.AutoFit
　　　　oApp.Visible = True
　　　　Set oApp = Nothing
End Sub

お礼

回答ありがとうございます！
参考に動かしてみたら、サブフォーム上では非表示にしているだけの列が出てしまったので、Excel側で消してみました。
　　　　Dim oApp As Object
　　　　Set oApp = CreateObject("Excel.Application")
　　　　oApp.Workbooks.Add

　　　　Me.サブフォーム名.SetFocus
　　　　DoCmd.RunCommand acCmdSelectAllRecords
　　　　DoCmd.RunCommand acCmdCopy

　　　　oApp.activesheet.Paste
　　　　oApp.Columns.EntireColumn.AutoFit

'不要な列を削除
MaxCol = oApp.ActiveSheet.Cells.CurrentRegion.Columns.Count
For i = 1 To MaxCol
strTitle = oApp.ActiveSheet.Range("A" & i).value

'本来は表示オプションボタンのTrueFalseを見てますが、仮に
If strTitle = "ID" Then
oApp.ActiveSheet.Range("A" & i).EntireColumn.Delete
End If
Next

　　　　oApp.Visible = True
　　　　Set oApp = Nothing

まだいじり中ですが、思ったように動いているようです！
ありがとうございます！
今の所特にエラーメッセージは無いのですが、本来の量のデータでも試してみようと思います。

補足

あ、嘘です（汗）色々とコードをいじった後でした。
列と行を間違えていたり、まだ全然でした。。。
もぅ少しいじってみます。

回答No.1

30246kiku

データシート上の列並びは、ColumnOrder で得られるようですが、ColumnOrder 順で得る方法はなさそうです。
最大項目数分の配列を用意して、並び順を自分で操作するしかないと思います。

上記を共通の処理として以下に分岐

１）クエリを作り、それをもとにExcel出力
２）自力でExcel出力

親フォームから処理するものとして、サブフォームコントロール名を「FSUB」と仮定します。

１）クエリを作り、それをもとにExcel出力
レコードの並び順（昇順/降順）を操作していた場合は、Me.FSUB.Form.OrderBy に項目名が入ります。
なければ、大元クエリの並び順をひっぱります。
操作でフィルタをかけていたら Me.FSUB.Form.Filter に条件が入ります。
大元クエリの条件と合わせて組み直します。
面倒だと思います。
（嘘を言っているかもしれないので、確認はしてください）
（OrderByOn / FilterOn も合わせて確認してください）

２）自力でExcel出力
例は、最大項目数を１０としています。
また、確認時、日付項目も入れていたので書式設定も入れてます。
（先頭が0の数字の文字列の時とかにも、書式設定が必要と思います）

データシートの項目に表示されているものを、見出しに使って、
それぞれのコントロールソースで RecordsetClone 内をなめてます。
表示データの並び順＝レコードセット内の並び順なので、単純に先頭から処理します。

データが多ければ、それなりに時間がかかります。
また、例では処理後Excelを表示しているだけなので、保存するのなら処理を追加してください。

動かないところがあれば、ドンドン修正してください。

例：親フォームからサブフォームに対して処理する例です）

Private Sub ToExcel_Click()
　　Dim oApp As Object
　　Dim iRow As Long, iCol As Long
　　Dim ctl As Control
　　Dim sDSn(1 To 10) As String
　　Dim sFn(1 To 10) As String
　　Dim i As Long

　　For i = 1 To 10
　　　　sDSn(i) = ""
　　　　sFn(i) = ""
　　Next
　　For Each ctl In Me.FSUB.Controls
　　　　With ctl
　　　　　　If (.ControlType <> acLabel) Then
　　　　　　　　If (.ColumnHidden = False) Then
　　　　　　　　　　sDSn(.ColumnOrder) = .Name
　　　　　　　　　　sFn(.ColumnOrder) = .ControlSource
　　　　　　　　End If
　　　　　　End If
　　　　End With
　　Next

'　　Dim sTmp As String
'　　sTmp = ""
'　　For i = 1 To 10
'　　　　sTmp = sTmp & i & ": " & sDSn(i) & vbCrLf
'　　Next
'　　MsgBox sTmp ' ここで、項目の並びがわかります（ここまで共通）

　　' 以下自力出力の例
　　With Me.FSUB.Form.RecordsetClone
　　　　If (.RecordCount = 0) Then Exit Sub
　　　　Set oApp = CreateObject("Excel.Application")
　　　　oApp.Workbooks.Add
　　　　iRow = 1
　　　　iCol = 1
　　　　For i = 1 To 10
　　　　　　If (Len(sDSn(i)) > 0) Then
　　　　　　　　oApp.Cells(iRow, iCol) = sDSn(i)
　　　　　　　　iCol = iCol + 1
　　　　　　End If
　　　　Next

　　　　.MoveFirst
　　　　While (Not .EOF)
　　　　　　iRow = iRow + 1
　　　　　　iCol = 1
　　　　　　For i = 1 To 10
　　　　　　　　If (Len(sFn(i)) > 0) Then
　　　　　　　　　　If (sFn(i) = "日付") Then
　　　　　　　　　　　　oApp.Cells(iRow, iCol).NumberFormatLocal _
　　　　　　　　　　　　　　= "yyyy/mm/dd"
　　　　　　　　　　End If
　　　　　　　　　　oApp.Cells(iRow, iCol) = .Fields(sFn(i)).Value
　　　　　　　　　　iCol = iCol + 1
　　　　　　　　End If
　　　　　　Next
　　　　　　.MoveNext
　　　　Wend
　　　　oApp.Columns.EntireColumn.AutoFit
　　　　oApp.Visible = True
　　　　oApp.UserControl = True
　　　　Set oApp = Nothing
　　End With
End Sub

※
データシートの左上四角部分をクリックしてコピー、Excelシート上で貼り付け、
の方が確かかと思います。（項目部分がわかりやすい表示になるとか）

お礼

回答ありがとうございます！
私にはなかなか難しいですが、参考になります！
最後の
”左上四角部分をクリックしてコピー、貼り付け”
案ありがとうございます！
bonaronさんのVBAを参考に、まずはこちらに挑戦してみます。