標準モジュールコピー for VBA

VB6,VBA,VBS,EXCEL,DOS,BAT,WSH,WORDの小技メモ

HTML/ CSS/ CGI-Perl/ JavaScript/ JavaApplet/ AccessUp/ Internet/ EnglishLearn/ ちゃいちゃん天使/ 天使メッセージ/ 飯田ワールド/ 結城ワールド/ プロフィール/ WEB相談室/ WEBアンテナ/ 燈明日記/ Perlノート/ 漢字起源/ yahoo

はじめに

本ページは、ウインドウズ系全般のティプスメモです。

そう、はじめはVB系のティプスメモだったのですが…いつの間にか、ウインドウズ系全般のティプスメモになってしまいました。

ちなみに、ティプス(Tips)とは、マニュアルに書かれていない技法や裏わざのことですが、本ページでは、私が経験してこれはと思ったノウハウのメモになっています。

尚、以下は本サイトの最新情報(ブログ)です。

それでは、本ページが何かのお役に立てれば幸いです。ごゆっくりご覧ください。

2009-04-24 標準モジュールコピー for VBA

ブックからブックへのシートコピーは、シートオブジェクトのcopyメソッドで、シート全体(内容データも制御データ)と、そしてシートモジュールまでもが一緒にコピーできます。


では、標準モジュール、クラスモジュール、フォーム、ThisWorkbookは、どうやってコピーするのでしょうか・・・。

これらは、VBProject.VBComponentsオブジェクトのExportメソッドで外に出し、同オブジェクトのImportメソッドで取り込み、コピーをします。

尚、ThisWorkbookに関しては、ソースコードを1行目から最終行まで指定してコピーします。


◆サンプルプログラム
Option Explicit
Sub TestCopyModule()

Dim Book1 As Workbook
Dim Book2 As Workbook

    Set Book1 = ThisWorkbook  '自ブックオブジェクト
    Set Book2 = Workbooks.Add '新規ブックオブジェクト

    If CopyModule(Book1, Book2) = -1 Then
       MsgBox "コピー失敗"
    End If
End Sub

Function CopyModule(ByVal orgBook As Workbook, ByVal cpyBook As Workbook) As Long
'引 数:orgBook コピー元ワークブックオブジェクト
'引 数:cpyBook コピー先ワークブックオブジェクト
'戻り値:成功 コピーしたモジュールの数(ThisWorkbookも含む)
Dim objVBC   As Object
Dim lngCount As Long
Dim strPath  As String
Dim strFile  As String
Dim strCode  As String

On Error GoTo COPY_ERROR

    strPath = orgBook.Path

    For Each objVBC In orgBook.VBProject.VBComponents
        Select Case objVBC.Type
            Case 1 To 3: '1:Module 2:Class 3:Form
                strFile = strPath & "\" & objVBC.Name
                'Export Module
                objVBC.Export Filename:=strFile
                'Import Module
                cpyBook.VBProject.VBComponents.Import Filename:=strFile
                lngCount = lngCount + 1
            Case 100: ' 100:Sheet or ThisWorkbook
                If objVBC.Name = "ThisWorkbook" Then
                    With orgBook.VBProject.VBComponents("ThisWorkbook").CodeModule
                         If .CountOfLines > 0 Then
                            strCode = .Lines(1, .CountOfLines)
                            With cpyBook.VBProject.VBComponents("ThisWorkbook").CodeModule
                                .InsertLines 1, strCode
                            End With
                         End If
                    End With
                    lngCount = lngCount + 1
                End If
        End Select
    Next
    CopyModule = lngCount
    Exit Function

COPY_ERROR:
    MsgBox Err.Description & " " & Err.Number
    CopyModule = -1
End Function

おわりに

以下のページには、すべてのTIPSがあります。もしよろしければ、どうぞ!

尚、ご感想、ご意見、誤字、脱字、間違い等がありましたら遠慮なくVB-TIPS掲示板へご指摘ください。