EXCEL VBA マクロでユーザーフォームをコピーする方法

質問

元のユーザーフォームが含まれたブックがありそれを、コピーし個人用に名前を入れそれに記入させようとしています
しかし作ったマクロでは標準モジュールはコピーされユーザーフォームはコピーされません
ユーザーフォームをコピーして標準モジュールはコピーしたくないのです
繰り返し処理をする良い方法もお願いします
Windows("元.xls").Activate
Sheets("報告書").Copy

Windows("元.xls").Activate
Sheets("名前").Range("C1:D1").Copy
Windows("Book1").Activate
Range("Q2:R2").Select’名前シートから個人名を入力
ActiveSheet.Paste

ActiveWorkbook.SaveAs Filename:="C:\Users\～～～～\" & "○○" & ".xls", ’個人名に変更
FileFormat _
:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
Workbooks("○○.xls").Close SaveChanges:=False

回答No.2

kenpon24 · ベストアンサー

その他のレスが付かないので続きを。

>元となるブックとは別のブックに、元となるブックをコピーするマクロを作ってそのコピーしたブックのシートでその一部のセルを変更するマクロを作ることができればうまくいくでしょうかね。

この案であればうまくいくでしょう。
わざわざ別のマクロを作らなくても、
#1で書いたマクロをシートモジュールに書いて、マクロを含むシートを削除して、内容をコピーするような動作を追加すれば1つのブックで完結できます。

サンプル これを含む複写したくないマクロをシートモジュール(報告書のシート)に記述
Sub test2()
Call test("○○")
End Sub

Sub test(個人名 As String)
Dim TempName As String
Dim TempBook As Workbook
Dim TempZoom As Integer
Dim TempIndex As Integer

On Error GoTo myExit

'現在の自分の名前を格納
TempName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
'自身を一時的な名前で保存
ThisWorkbook.SaveAs ThisWorkbook.Path & "\temp.xls"
'元ブックの名前を変更
Name TempName As ThisWorkbook.Path & "\" & 個人名 & ".xls"
'自身の名前を元に戻す
ThisWorkbook.SaveAs TempName
'一時的なブックを消す
Kill (ThisWorkbook.Path & "\temp.xls")

'現在のシートのズームと名前を覚える
TempZoom = ActiveWindow.Zoom
TempName = ActiveSheet.Name
TempIndex = ActiveSheet.Index
'作成したブックを開く
Workbooks.Open (ThisWorkbook.Path & "\" & 個人名 & ".xls")
Set TempBook = Workbooks(個人名 & ".xls")

Application.DisplayAlerts = False
With TempBook
.Activate
'シート追加
.Worksheets.Add before:=.Worksheets(TempName)
'マクロを含むシートを削除
.Worksheets(TempName).Delete

'このブックのデータをコピーして貼り付ける
ThisWorkbook.Activate
Cells.Copy
.Activate

With .Worksheets(Sheets.Count)
.Cells.PasteSpecial xlPasteAll
.Name = TempName
.Activate
.Range("A1").Select
End With

ActiveWindow.Zoom = TempZoom

'上書き保存して閉じる
.Save
.Close
End With

Application.DisplayAlerts = True
Application.CutCopyMode = False

myExit:

End Sub

回答No.1

kenpon24

ユーザフォームをコピーしたいのであれば、ブック自体をコピーする必要があります。(たぶん)

コピーはFilecopyステートメントでできますが、
書き込み可能な状態で開いている場合、Filecopyステートメントでは自身をコピーできません。

こちらの方法を使うか、
http://okwave.jp/qa4263527.html

一時的に名前を変えたりしてコピーできます
サンプル
Sub test(個人名 As String)
Dim TempName As String
'現在の自分の名前を格納
TempName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
'自身を一時的な名前で保存
ThisWorkbook.SaveAs ThisWorkbook.Path & "\temp.xls"
'元ブックの名前を変更
Name TempName As ThisWorkbook.Path & "\" & 個人名 & ".xls"
'自身の名前を元に戻す
ThisWorkbook.SaveAs TempName
'一時的なブックを消す
Kill (ThisWorkbook.Path & "\temp.xls")
End Sub

ただし、ブックをまるごとコピーすると、標準モジュールもコピーされます。
どうしても標準モジュールをコピーしたくないのであれば、別途手順が必要になるでしょう。

お礼

回答していただきありがとうございます。

なるほど。ブックをコピーすればユーザーフォームもコピーされるはずですね。
となると、自分自身をコピーする標準モジュールもコピーされてしまうと。
では、元となるブックとは別のブックに、元となるブックをコピーするマクロを作ってそのコピーしたブックのシートでその一部のセルを変更するマクロを作ることができればうまくいくでしょうかね。