質問: 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 --- これではメインフォームのコピーしか出来ません。 サブフォームも一緒にコピーしたいのですが、どういった方法があるでしょうか。 宜しくお願いいたします。
回答: 最初の回答の"この回答への補足"で、 [サブフォームの表示コントロール]の名前を サブフォームと同じにした、ということですが このようにすると何かと混乱のもとになるので 例えば、サブフォームの名前が サブフォーム1ならば、コントロールの 名前は違う名前、たとえばサブフォーム1sub あるいはobjサブフォーム1のように変えてください。 ときにはコードが動きません。サブフォームの データが取れないのもそのあたりにあります。 提示したコードでは set rst = me!サブフォーム表示コントロール名.form.recordsetclone の部分も変更します。 それから、 >メインテーブルのフィールドが100を超える為、 >教えて頂いたように行数を足していくのは >現実的ではありません。 このようなことは最初に情報をくださいませ。 では、du-samaさんが最初に提示したコードを そのまま利用して、以下のようにします。 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 rs = db.openrecordset("サブテーブル", dbopendynaset) 'サブフォーム表示コントロール名は変更してください。 set rst = me!サブフォーム表示コントロール名.form.recordsetclone 'msgboxで引数たとえばvbokcancelなどを設定するときは()でかこいません msgbox "◆内容のコピーを作成しますか?◆", vbokcancel if vbok then 'メインフォームのデータのコピー docmd.domenuitem acformbar, aceditmenu, 8, , acmenuver70 docmd.domenuitem acformbar, aceditmenu, 2, , acmenuver70 docmd.domenuitem acformbar, aceditmenu, 5, , acmenuver70 'サブフォームのデータのコピー 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 end with else 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 rst.close set rst = nothing db.close set db = nothing end sub