ACCESSのサブフォームコピーについて

ACCESSのサブフォームコピーについて

お世話になります。色々検索してたのですがなかなか解決できず、教えて下さい。

下記のようなフォームがあります。
メインフォームにボタンを設置し、メインフォームとサブフォームを同時にコピーしたいです。

【メインフォーム】
ID（オートナンバー）
登録名
住所
電話番号
など

【サブフォーム】
SubID（オートナンバー）
ID（メインフォームと連結）
ライセンス数
開始日
など

メインフォームの「内容のコピーを作成」ボタンのクリック時の[イベント プロシージャ]に下記が記載してあります。
---
Private Sub 内容のコピーを作成_Click()
On Error GoTo Err_内容のコピーを作成_Click

Select Case MsgBox(srchXls & "◆内容のコピーを作成しますか？◆", vbOKCancel)
Case vbOK

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 2, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 5, , acMenuVer70 'Paste Append

MsgBox (srchXls & Chr(13) & Chr(10) & "◆コピーを作成しました◆")

Err_内容のコピーを作成_Click:

Case Else
Exit Sub
End Select
End Sub
---

これではメインフォームのコピーしか出来ません。
サブフォームも一緒にコピーしたいのですが、どういった方法があるでしょうか。

宜しくお願いいたします。

No.7 回答者： DexMachina 回答日時： 2010/05/14 22:56

No.1での補足で、すぐに解決するかと思っていたのですが・・・(汗)

以下のような動作がご希望と推測します：

<コピー元>
【メイン】
　ID=1、登録名=氏名1、・・・
【サブ】
　SubID=1、ID=1、・・・
　SubID=2、ID=1、・・・

<複製結果>
【メイン】
　ID=8、登録名=氏名1、・・・
【サブ】
　SubID=15、ID=8、・・・
　SubID=16、ID=8、・・・


以下、この前提での対応策です：

Private Sub 内容のコピーを作成_Click()
On Error GoTo Err_内容のコピーを作成_Click

　　Dim strMsg As String, NewID As Long, RecCnt As Long, myBkmk As String

　　'キャンセル選択時は即終了
　　strMsg = srchXls & vbCrLf & "◆内容のコピーを作成しますか?◆"
　　If MsgBox(strMsg, vbOKCancel) = vbCancel Then GoTo 終了処理

　　'現在位置の記録＆サブ側の有無確認
　　myBkmk = Me.Bookmark
　　RecCnt = Me!サブテーブル.Form.RecordsetClone.RecordCount

　　'メイン側の複製(DoMenuItemは旧バージョン用のためRunCommandに置換)
　　'※「acCmdPasteAppend」を使用すると追加貼付は1行で済みますが、以降、
　　'　 諸々の不具合を生じるため、「移動・選択・貼付」に分割
　　DoCmd.SetWarnings False　　　'確認メッセージの非表示化
　　RunCommand acCmdSelectRecord
　　RunCommand acCmdCopy
　　DoCmd.GoToRecord acDataForm, Me.Name, acNewRec
　　RunCommand acCmdSelectRecord
　　RunCommand acCmdPaste
　　RunCommand acCmdSaveRecord

　　'サブ側の複製(レコード存在時のみ)
　　If RecCnt Then

　　　　'元のレコードに戻ってサブ側をコピー
　　　　Me.Bookmark = myBkmk
　　　　Me!サブテーブル.SetFocus
　　　　RunCommand acCmdSelectAllRecords
　　　　RunCommand acCmdCopy
　　　　
　　　　'メイン側の複製レコード(=末尾)に移動して貼付
　　　　DoCmd.GoToRecord acDataForm, Me.Name, acLast
　　　　Me!サブテーブル!ID.SetFocus
　　　　DoCmd.GoToRecord , , acNewRec　　'サブでは第1・2引数は指定不可
　　　　RunCommand acCmdSelectRecord
　　　　RunCommand acCmdPaste
　　　　RunCommand acCmdSaveRecord

　　　　'IDの書換
　　　　NewID = Me!ID　　'新規IDを記録
　　　　With Me!サブテーブル.Form.RecordsetClone
　　　　　　.MoveFirst
　　　　　　Do Until .EOF
　　　　　　　　.Edit
　　　　　　　　!ID = NewID
　　　　　　　　.Update
　　　　　　　　.MoveNext
　　　　　　Loop
　　　　　　.MoveFirst
　　　　End With
　　　　Me!サブテーブル.Form.Refresh

　　End If

　　'終了時に元のレコードを表示させたい場合は以下の1行を有効化
　　'Me.Bookmark = myBkmk

　　'メッセージを表示
　　Call MsgBox(srchXls & vbCrLf & "◆コピーを作成しました◆")

終了処理:
　　'確認メッセージの設定を元に戻す
　　DoCmd.SetWarnings True
　　'Subを抜ける(入れ忘れるとエラー処理が無限ループ化)
　　Exit Sub

Err_内容のコピーを作成_Click:
　　MsgBox Err.Number & "：" & Err.Description, , Me.Name & " 内容のコピーを作成_Click"
　　Resume 終了処理

End Sub


・・・以上です。

※字数制限に引っ掛かったため、コメント等は最小限に留めました(汗)

この回答への補足

回答ありがとうございます。

「2465:指定した式で参照されている'サブテーブル'フィールドが見つかりません。」

というエラーが出て、メインフォームもサブフォームもコピーされません。


私が希望する動作は＜コピー元＞＜複製結果＞で示して頂いた動作で合っています。

教えて頂いた式で私が編集しなければならない個所は「サブテーブル」の部分を本物のサブテーブルの名前にするだけだと思うのですが、それで合っていますでしょうか。

'メイン側の複製(DoMenuItemは旧バージョン用のためRunCommandに置換)

とはどういう意味ですか？今更ですが、ACCESSは2000です。2007にしたら動かないマクロが出てしまい、他に諸事情もあり当面2000で使用しています。（ファイルも2000で作成しました）
旧バージョンとはACCESSのことでしょうか。。

サブ側でIDを編集することが稀にあります。
サブフォームはデータシートでなければだめでしょうか。。帳票フォームにしていました。見栄えの問題です。

補足日時：2010/05/15 23:37

No.6 回答者： piroin654 回答日時： 2010/05/14 14:04

訂正です。

コードの一番下の部分。


rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub


を


rs.Close
Set rs = Nothing
rst.Close
Set rst = Nothing
rsm.Close
Set rsm = Nothing
db.Close
Set db = Nothing
End Sub


のようにしてください。記述漏れがありました。

この回答への補足

度々回答ありがとうございます。

メインテーブルは同じメインテーブルへ、サブテーブルは同じサブテーブルへコピーです。

メインテーブルのフィールドが100を超える為、教えて頂いたように行数を足していくのは現実的ではありません。

質問に記載したようにまるごとコピーに出来ますでしょうか。

あと、メッセージボックスは最初の「コピーしますか？」ＯＫ　or　キャンセル
と最後の「コピーしました」だけで大丈夫です。

＞MsgBox ("サブフォームにレコードがありません。")

サブフォームにはレコードがある時とない時がありますが、メッセージに出す必要はありません。


自分で修正しようと思いましたが、サブテーブルがコピーされず、断念しました。。。
度々お手数ですが、教えて頂けないでしょうか。

宜しくお願いいたします。

補足日時：2010/05/14 22:32

No.5 回答者： piroin654 回答日時： 2010/05/13 19:01

メインフォームのデータはメインテーブルへ。

サブフォームのデータはサブテーブルへ。

それぞれ入れる仕様になっています。

もし、メインフォームのデータも、サブフォームの
データも同一のテーブルに入れるのなら、少し
変更がありますから、その場合は言ってください。

No.4 回答者： piroin654 回答日時： 2010/05/13 18:56

私の質問の仕方が良くなくて、(3)のところが

不明瞭なので、不安なのですが一応確かめて
ください。設定などでわからないところが
あれば書き込んでください。

なお、MsgBoxのsrchXlsは変数が設定されていないので
はずしておきます。必要なら再設定してください。
一応、必要なことはコードの中に書いてあります。

Private Sub mcdコピー開始_Click()
Dim db As Database
Dim rsm As Recordset
Dim rs As Recordset
Dim rst As Recordset
Dim i As Integer


On Error GoTo Er_ha
Set db = CurrentDb
Set rsm = db.OpenRecordset("メインテーブル", dbOpenDynaset)
Set rs = db.OpenRecordset("サブテーブル", dbOpenDynaset)
Set rst = Me!フォームsub.Form.RecordsetClone

'MsgBoxで引数たとえばvbOKCancelなどを設定するときは()でかこいません
MsgBox "◆内容のコピーを作成しますか？◆", vbOKCancel
If vbOK Then
'メインフォームのデータのコピー
With rsm
rsm.AddNew

'rsm側はテーブルのフィールド名
'Me側はメインフォームのコントロールの名前
'コントロールの名前がtxt登録名ならば変更してください。
''他に項目があるなら同じような形式で追加してください。

'IDは必要ないと思われるのでコメントアウトしておきます。
'必要なら先頭の'をはずしてください。
'rsm![ID] = Me![ID]
rsm![登録名] = Me![登録名]
rsm![住所] = Me![住所]
rsm![電話番号] = Me![電話番号]
'rs![その他の項目] = rst![その他の項目]

rsm.Update
MsgBox ("メインフォームのコピー終了")
End With

'サブフォームのデータのコピー
If rst.RecordCount > 0 Then
With rst
rst.MoveFirst
Do Until .EOF
rs.AddNew
'IDは必要ないと思われるのでコメントアウトしておきます。
'必要なら先頭の'をはずしてください。
'rs![ID] = rst![ID]
rs![ライセンス数] = rst![ライセンス数]
rs![開始日] = rst![開始日]

'以下、他に項目があるならその他の項目を置き換えてください。
'必要なときは先頭の'をはずしてください
'同様にして他の項目を追加してください。

'rs![その他の項目] = rst![その他の項目]
rs.Update
rst.MoveNext
Loop

MsgBox ("サブフォームのコピー終了")
End With
Else
MsgBox ("サブフォームにレコードがありません。")
End If
MsgBox ("コピー終了しました")
End If
'エラー処理
Er_ha:
If Err.Number <> 0 Then
MsgBox (Err.Number & vbCrLf & Err.Description)
End If


rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Sub

No.3 回答者： piroin654 回答日時： 2010/05/12 01:42

遅くなってすみません。

少し整理させてください。

(1)
メインフォームとサブフォームのレコードソースは
それぞれテーブルですか。

(2)
サブフォームにsubID(オートナンバー)がIDとは
別にあるのは何か理由がありますか。
普通は、IDが連動しているので言わばサブフォームの
データはメインフォームのデータの詳細
ですから特別な理由がない限り必要ないのでは
と思いますが。

(3)
メインフォームのデータをコピーして張り付ける
先と、サブフォームのデータをコピーして
貼り付ける先は別々ですか。
また、例えばメインフォームのレコードソースが
テーブルAとするとコピーして張り付ける先は
別のテーブルですか。同様にサブフォームはどうですか。


以上です。フォームのデータのコピーについては
やはり、ウィザードによるマクロを使わずに
Recordsetを利用したほうが確実です。
(1),(2),(3)がわかればコードは提示できます。

この回答への補足

またまたお世話になります。

(1)　レコードソースは
メインフォーム→クエリ、サブフォーム→テーブル　です。

(2)特に意味はありません。各テーブルには主キーとなるフィールドが必要でいつもIDという名称でオートナンバーをつけておりました。思いこみですね。。。
他に連携しているところもありませんので、削除してしまっても大丈夫です。

(3)メインもサブも貼り付け先はそれぞれ同じテーブルです。

お付き合い頂き感謝です。

Recordsetを利用した方が確実とのことですが、その意味すら分からない素人です。。

コピーする前と後のメッセージボックスも満たしているのであれば、どんな方法でもかまいません。

補足日時：2010/05/12 20:02

No.2 回答者： piroin654 回答日時： 2010/05/07 22:45

少し訂正します。

(1)
'追加クエリ
strSQL = "INSERT INTO サブテーブル ( ID, ライセンス数, 開始日 ) "
strSQL = strSQL & "SELECT サブテーブル.ID, サブテーブル.ライセンス数, サブテーブル.開

始日 "
strSQL = strSQL & "FROM サブテーブル "
strSQL = strSQL & "WHERE (((サブテーブル.ID)=[Forms]![メインフォーム]![ID]));"

のところで、

>strSQL = "INSERT INTO サブテーブル ( ID, ライセンス数, 開始日 ) "

を

strSQL = "INSERT INTO サブテーブル ( ライセンス数, 開始日 ) "

としてください。IDは追加しないので除きます。

(2)
[サブフォームの表示コントロール]とは
サブフォームそのものではなく、
メインフォームでサブフォームを
表示するコントロールを示します。
メインフォームでサブフォームを表示する
コントロールを貼り付けると、既定値では
埋め込み0とかいう名前で登録されます。
それを指しています。したがって、サブフォームの
コントロールを指す場合は、

Me![サブフォームの表示コントロール].Form.Requery

のようにします。これよりも

Me![サブフォームの表示コントロール名].Form.Requery

のほうが誤解がないかもしれません。

エラーが出るようであればエラー番号、内容
など、また表示が出来ない場合はその状況を
おしえてください。

この回答への補足

再び回答ありがとうございます。

まず、

>strSQL = "INSERT INTO サブテーブル ( ID, ライセンス数, 開始日 ) "

を

strSQL = "INSERT INTO サブテーブル ( ライセンス数, 開始日 ) "

にし、

[サブフォームの表示コントロール名]のところを訂正しました。

メインフォーム上でサブフォームを1回だけクリックし、プロパティにある「名前」の部分ですよね。
こちらはサブフォームと同じ名前に変更していたので、サブフォームと同じ名前を入れました。

ですが。。。

サブレコードはコピーされなくなり、エラーも何も出ませんでした。
メインレコードだけコピーされた状態です。

おや？と思い、前の状態に戻しましたが、今度は戻したはずがNo.1に補足させて頂いた時のように
IDが元のままコピーされるのではなく、サブレコードが全くコピーされなくなってしまいました。

ん～～なんででしょう。。

どこか間違って消してしまったりしたのかと思い、No.1で補足した文をそのままコピーしてやり直してもだめでした。。

すみません、謎です。。

教えて頂いた文があっていたとすると、何か他に原因があるように思えますが、エラーも出ませんし、どこをチェックしたらよいか何か案はありますでしょうか。

今記述したのは以下のとおりです。
---
Private Sub 内容のコピーを作成_Click()
On Error GoTo Err_内容のコピーを作成_Click

Select Case MsgBox(srchXls & "◆内容のコピーを作成しますか？◆", vbOKCancel)
Case vbOK

'参照設定でDAOにチェック
Dim db As Database
Dim strSQL As String

Set db = CurrentDb
DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 2, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 5, , acMenuVer70 'Paste Append

DoCmd.RunCommand acCmdSaveRecord

'以下サブフォームのコピー
'追加クエリ
strSQL = "INSERT INTO サブテーブル ( ライセンス数, 開始日, 終了日, メモ ) "
strSQL = strSQL & "SELECT サブテーブル.ID, サブテーブル.ライセンス数, サブテーブル.開始日, サブテーブル.終了日, サブテーブル.メモ "
strSQL = strSQL & "FROM サブテーブル "
strSQL = strSQL & "WHERE (((サブテーブル.ID)=[Forms]![メインフォーム]![ID]));"

db.Execute strSQL, dbFailOnError
Me![サブテーブル].Form.Requery

MsgBox (srchXls & Chr(13) & Chr(10) & "◆コピーを作成しました◆")

db.Close

Set db = Nothing

Err_内容のコピーを作成_Click:

Case Else
Exit Sub
End Select
End Sub
---

補足日時：2010/05/09 21:54

この回答へのお礼

すみません、再度補足です。
全く関係ないかもしれませんが、そういえば2つ目のメッセージボックス

MsgBox (srchXls & Chr(13) & Chr(10) & "◆コピーを作成しました◆")

は表示されなくなっているようです。

お礼日時：2010/05/09 23:12

No.1 回答者： piroin654 回答日時： 2010/05/07 02:00

VBAでRecordsetを使ってテーブルにコピー

する方法や、追加クエリを使う方法が
あります。以下は追加クエリでの一例。
テーブルをT登録、T登録明細とします。
それぞれメインフォーム、サブフォームの
レコードソースの一部とします。コピー先、
コピー内容は適当です。


'参照設定でDAOにチェック
Dim db As Database
Dim strSQL As String

Set db = CurrentDb


>DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
>DoCmd.DoMenuItem acFormBar, acEditMenu, 2, , acMenuVer70
>DoCmd.DoMenuItem acFormBar, acEditMenu, 5, , acMenuVer70 'Paste Append

DoCmd.RunCommand acCmdSaveRecord

'以下サブフォームのコピー
'追加クエリ
strSQL = "INSERT INTO T登録明細 ( ID, ライセンス数, 開始日, その他項目 ) "
strSQL = strSQL & "SELECT T登録明細.ID, T登録明細.ライセンス数, T登録明細.開始日, T登録明細.その他項目 "
strSQL = strSQL & "FROM T登録明細 "
strSQL = strSQL & "WHERE (((T登録明細.ID)=[Forms]![メインフォーム]![ID]));"

db.Execute strSQL, dbFailOnError
Me![サブフォームの表示コントロール].Form.Requery

>MsgBox (srchXls & Chr(13) & Chr(10) & "◆コピーを作成しました◆")


db.Close
Set db = Nothing
End Sub


このような感じです。
ms access　サブフォーム　コピー
でググればわんさか例が出てきます。

この回答への補足

回答ありがとうございます。
以下のように記述してみましたが、サブテーブルのコピー後のIDが元のIDと同じになってしまい、新しいコピー後のメインフォームにくっつきませんでした。
何が間違っているかわかりますでしょうか？
---
Private Sub 内容のコピーを作成_Click()
On Error GoTo Err_内容のコピーを作成_Click

Select Case MsgBox(srchXls & "◆内容のコピーを作成しますか？◆", vbOKCancel)
Case vbOK

'参照設定でDAOにチェック
Dim db As Database
Dim strSQL As String

Set db = CurrentDb
DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 2, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 5, , acMenuVer70 'Paste Append

DoCmd.RunCommand acCmdSaveRecord

'以下サブフォームのコピー
'追加クエリ
strSQL = "INSERT INTO サブテーブル ( ID, ライセンス数, 開始日 ) "
strSQL = strSQL & "SELECT サブテーブル.ID, サブテーブル.ライセンス数, サブテーブル.開始日 "
strSQL = strSQL & "FROM サブテーブル "
strSQL = strSQL & "WHERE (((サブテーブル.ID)=[Forms]![メインフォーム]![ID]));"

db.Execute strSQL, dbFailOnError
Me![サブテーブル].Form.Requery

MsgBox (srchXls & Chr(13) & Chr(10) & "◆コピーを作成しました◆")

db.Close

Set db = Nothing

Err_内容のコピーを作成_Click:

Case Else
Exit Sub
End Select
End Sub
---

検索しても沢山HITして自分で試行錯誤はしたのですが、こういった感じで問題が解決できなかったので新たに質問させて頂いた次第です。。。

あと、[サブフォームの表示コントロール]が分からなかったのですが、サブフォームのレコードソースではないですよね。。。
こちらはどこを見たら分かるでしょうか。
検索したところ、サブフォームの「名前」（今回の場合はレコードソースと同じ名前です）かなと思って入れてもみましたが、その場合はサブレコードのコピーは出来ませんでした。

補足日時：2010/05/07 20:51