none
VBA Book1のモジュールをBook2にコピーする RRS feed

  • 質問

  • MyPC:Windiws10,Excel2016(32bit)
    次のコードを実行しようとしたのですが、「With Workbooks()」の2ヵ所で実行エラーが発生します。
    誰か正しいコードを教えて下さい。
    ※Book1にあるModule1をBook2にコピーします。Book1とBook2は、どちらもExcelで開いているとします。
    Sub Sample4()
        Dim VBP, Code As String
        With Workbooks("wBook1").VBProject.VBComponents("Module1").CodeModule
            Code = .Lines(1, .CountOfLines)
        End With
        With Workbooks("wBook2").VBProject.VBComponents.Add(1)
            .CodeModule.AddFromString Code
        End With
    End Sub

    u793nabe

    2020年8月15日 7:30

回答

  • こんにちは。
    外部ファイルとして出力することなく、コードのみを他のブックにコピーしたいということでしょうか。

    何れにしても、ご提示いただいたコードのWith部分で引っ掛かっているのであれば、ブックがちゃんと指定できているかを確認した方が良いかと思います。

    Public Sub Sample()
      Dim wb1 As Excel.Workbook, wb2 As Excel.Workbook
      Dim code As String
      
      Set wb1 = Application.Workbooks("Book1.xlsm") 'ファイル名で指定しているか確認
      With wb1.VBProject.VBComponents("Module1").CodeModule
        code = .Lines(1, .CountOfLines)
      End With
      
      Set wb2 = Application.Workbooks("Book2.xlsm")
      With wb2.VBProject.VBComponents.Add(1) '標準モジュール追加
        .CodeModule.AddFromString code
      End With
    End Sub


    • 回答としてマーク u793nabe 2020年8月18日 7:30
    2020年8月18日 2:36

すべての返信

  • セキュリティセンターの設定で、VBAオブジェクトモデルへのアクセスを信頼するとチェックはありますか?

    また、参照設定[Microsoft Visual Basic for Applications Extensibility]は有効ですか?

     以下、参考ttps://docs.microsoft.com/ja-jp/previous-versions/office-development/cc345342(v=msdn.10)?redirectedfrom=MSDN

    indexエラーが出てましたか? とりあえず、動くように試行錯誤してみました。

    何故だかわかりませんが、workbook("1")をThisworkbookにするとVBcomponent以降の参照が通るようになります。

        With Workbooks("wBook1").VBProject.VBComponents("Module1").CodeModule
            Code = .Lines(1, .CountOfLines)
        End With

    With ThisWorkbook.VBProject.VBComponents("Module1").CodeModule Code = .Lines(.CountOfDeclarationLines, .CountOfLines) End With

    WorkbooksをWATCH式で見て、

    +Item1 

    - Item2

      Name "wBook2" 

    追加したい先の"wBook2"workbookを含むitem2と同じインデックス2を指定したら動きます。

        With Workbooks(2).VBProject.VBComponents.Add(1)
            .CodeModule.AddFromString Code
        End With

    多分これで動くと思います。



    • 編集済み NPK_exc 2020年8月15日 13:44
    2020年8月15日 13:43
  • NPK_excさん早々のご回答ありがとうございます。
    ≪確認≫
    ・セキュリティセンターの設定で、VBAオブジェクトモデルへのアクセスを信頼するとチェックはありますか? …はい
    ・また、参照設定[Microsoft Visual Basic for Applications Extensibility]は有効ですか? …はい
    以上の通りでした。
    ≪試行≫
    ご提示いただいたコードに差替え試行してはみましたが、非力にて完結できませんでした。
    願わくば「追加したい先の"wBook2"workbookを含むitem2と同じインデックス2を指定したら動きます。」の内容を含むマクロの全文をご提示いただければ幸いです。
    よろしくお願いいたします。

    u793nabe

    2020年8月15日 15:21
  • こんにちは。
    単に標準モジュールをコピーするだけであれば、エクスポート&インポートしてはいかがでしょうか。
    Public Sub Sample()
      Dim wb1 As Excel.Workbook, wb2 As Excel.Workbook
      Const mod_path As String = "C:\wk\Module1.bas"
      
      Set wb1 = Application.Workbooks("Book1")
      wb1.VBProject.VBComponents("Module1").Export mod_path '標準モジュールのエクスポート
      
      Set wb2 = Application.Workbooks("Book2")
      wb2.VBProject.VBComponents.Import mod_path '標準モジュールのインポート
    End Sub
    2020年8月17日 1:01
  • きぬあさ様ご回答ありがとうございます。
    せっかくのご提案ですが、やりたい事はコピーです。
    質問に記述した「Sub Sample4()」が実行できれば願ったり叶ったりなのですが…
    これWebをググって見つけたSampleです。
    掲載者に失礼なのでサイトは割愛しますが本当に動作するのでしょうか?
    どの様に修正すれば動作するのでしょうか?
    実行Errorが発生するのは私のPC環境だけなのか婚悪しています。
      :
      :



    u793nabe

    2020年8月18日 0:34
  • こんにちは。
    外部ファイルとして出力することなく、コードのみを他のブックにコピーしたいということでしょうか。

    何れにしても、ご提示いただいたコードのWith部分で引っ掛かっているのであれば、ブックがちゃんと指定できているかを確認した方が良いかと思います。

    Public Sub Sample()
      Dim wb1 As Excel.Workbook, wb2 As Excel.Workbook
      Dim code As String
      
      Set wb1 = Application.Workbooks("Book1.xlsm") 'ファイル名で指定しているか確認
      With wb1.VBProject.VBComponents("Module1").CodeModule
        code = .Lines(1, .CountOfLines)
      End With
      
      Set wb2 = Application.Workbooks("Book2.xlsm")
      With wb2.VBProject.VBComponents.Add(1) '標準モジュール追加
        .CodeModule.AddFromString code
      End With
    End Sub


    • 回答としてマーク u793nabe 2020年8月18日 7:30
    2020年8月18日 2:36
  • 【返信】
    きぬあさ様ご回答ありがとうございます。
    ご丁寧なアドバイスに感謝しています…お陰様で問題が解決しました…感謝
    Workbooks("wBook1") ↓
    Workbooks("wBook1.xlsm")と、
    ブックのファイル拡張子を書き添える必要がある事が良く理解できました。

    u793nabe

    • 回答の候補に設定 NPK_exc 2020年8月18日 9:33
    2020年8月18日 7:30
  • Sub Sample4()
        Dim VBP, Code As String
        With ThisWorkbook.VBProject.VBComponents("Module1").CodeModule
            Code = .Lines(.CountOfDeclarationLines, .CountOfLines)
        End With
        With Workbooks(2).VBProject.VBComponents.Add(1)

            .CodeModule.AddFromString Code
        End With
    End Sub

    -Workbooks

      +Item1

      -Item2

       ...

      Name "コピー先のファイル名"


    Workbooks(2)をWorkbooksまでをドラッグして、右クリック後ウォッチ式の追加、下のWithの部分でブレークポイントを設定するとウォッチ式が見れると思います。( 見れない場合、メニュー「表示(V)」→「ウォッチ ウィンドウ」)
    ●   With ThisWorkbook.VBProject.VBComponents("Module1").CodeModule
    
            Code = .Lines(.CountOfDeclarationLines, .CountOfLines)
        End With

    はworkbook1⇒workbook2 workbook⇒workbook3 workbook1⇒workbook4...

    といった形で、コピー元に書いておくと流用が効くかもしれません。

     解決済みだと思いますが、上の物が全文になります。レスポンスが遅くなりすみません。


    • 編集済み NPK_exc 2020年8月18日 11:21
    2020年8月18日 11:21
  • NPK_excさん回答ありがとうございます。
    実はNPK_excさん回答を基に「TargetBookのindex取得」方法を色々試み成功したので成果報告をしようと、
    本リンクを開いたら「きぬあさ」さんからの回答がありました。
    これがベストアンサーと思い「回答としてマーク」させていただきました。
    従い次の「Sample4a」コードの報告は割愛していました。が、
    更なるNPK_excさんの回答に報いるために次の自動化コードを開示いたします。
    (勿論、実践用には色々馬鹿除けを追加する必要はあります)
    Sub Sample4a()
        Dim VBP, code As String
        With ThisWorkbook.VBProject.VBComponents("Module1").CodeModule
            code = .Lines(1, .CountOfLines)
        End With
        
        Dim i As Long, flag As Boolean
        For i = 1 To Workbooks.Count
            If Workbooks(i).Name = "wBook2.xlsm" Then '←★TargetBookのindex取得
                flag = True
                Exit For
            End If
        Next i
        If flag <> True Then Exit Sub
        
        With Workbooks(i).VBProject.VBComponents.Add(1)
            .CodeModule.AddFromString code
        End With
    End Sub

    u793nabe


    • 編集済み u793nabe 2020年8月19日 6:38 誤字訂正
    2020年8月18日 13:04