Accessなどのデータベースを使用するのが当たり前だが
私はExcel愛好者なので、Excelを使用する！
xx.basで保存→Excelbook1 basの呼び出し→Excelbook1読み込みモジュール→
Excelbook2保存data
では出来ないだろうか？
呼び出したいモジュールとして，下記のような２つがあるとしよう。
まずは，これらをそれぞれ自由にエディタ（メモ帳とか）で書いて，ファイルとして保存。
HogeModule.bas
'---------------------------------------------------------------
' hogeのためのモジュール。
Attribute VB_Name = "HogeModule"
Sub hoge()
MsgBox "hoge"
End Sub
Function hello(x)
hello = "Hello, " & x &
"!"
End Function
'---------------------------------------------
FugaModule.bas
' fugaのためのモジュール。 Attribute VB_Name = "FugaModule" Sub fuga() MsgBox "fuga" End Sub '----------------------------
そして，これらの２つを呼び出したいという旨，設定ファイルに記述する。
下記のように。
libdef.txt
'---------------------------------
.\HogeModule.bas .\FugaModule.bas
'--------------------------------
次に，呼び出したい側のエクセルファイルに，モジュールを自動的に読み込むという設定を書く。
事前に下記の設定を行なっておくこと。
(Excel2003の場合)
ツール＞マクロ＞セキュリティ＞信頼できる発行元＞Visual Basic プロジェクトへのアクセスを信頼する をオン
(Excel2007の場合)
リボンの「開発」タブ＞マクロのセキュリティ＞VBAプロジェクトオブジェクトモデルへのアクセスを信頼する
http://support.microsoft.com/kb/282830/ja
※「プログラミングによるVisual Basicプロジェクトへのアクセスは信頼性に欠けます」というエラーメッセージが出ないようになる。
'------------------------------------------------------------------------------------------------------
ここでは，呼び出し側のファイルをcaller.xlsとする。
「ブックを開いたときに自動的に〜〜」という処理は ThisWorkbook の中に書く。
下記の内容をコピペ。
caller.xls のThisWorkbook
'----------------------------------------------------------------------------------------------------------------
' ワークブックを開く時のイベント Private Sub Workbook_Open() ' txtに書いてある外部ライブラリを読み込み load_from_conf ".\libdef.txt" End Sub
'------------------------------------------------------------------------------------------------------------------------
' -------------------- モジュール読み込みに関する関数 --------------------
' 設定ファイルに書いてある外部ライブラリを読み込みます。
Sub load_from_conf(conf_path)
' 全モジュールを削除
clear_modules
' 絶対パスに変換
conf_path = abs_path(conf_path)
If Dir(conf_path) = "" Then
MsgBox "外部ライブラリ定義" & conf_path & "が存在しません。"
Exit Sub
End If
' 読み取り
fp = FreeFile
Open conf_path For Input As #fp
Do Until EOF(fp)
' １行ずつ
Line Input #fp,
temp_str
If Len(temp_str) > 0 Then
module_path = abs_path(temp_str)
If Dir(module_path) = "" Then
' エラー
MsgBox "モジュール" & module_path & "は存在しません。"
Exit Do
Else
' モジュールとして取り込み
include module_path
End If
End If
Loop
Close #fp
ThisWorkbook.Save
End Sub
' あるモジュールを外部から読み込みます。
' パスが.で始まる場合は，相対パスと解釈されます。
Sub include(file_path)
' 絶対パスに変換
file_path = abs_path(file_path)
' 標準モジュールとして登録
ThisWorkbook.VBProject.VBComponents.Import
file_path
End Sub
' 全モジュールを初期化します。
Private Sub clear_modules()
For Each component In ThisWorkbook.VBProject.VBComponents
If component.Type = 1 Then
' この標準モジュールを削除
ThisWorkbook.VBProject.VBComponents.Remove component
End If
Next component
End Sub
' ファイルパスを絶対パスに変換します。
Function abs_path(file_path)
' 絶対パスに変換
If Left(file_path, 1) = "." Then
file_path = ThisWorkbook.Path & Mid(file_path, 2, Len(file_path) - 1)
End If
abs_path = file_path
End Function
これで完了だ。
caller.xlsを開くと，HogeModule.hoge() も FugaModule.fuga() も実行可能な状態になっている。
'----------------------------------------------------------------------------------------------------------------
備考
- ワークブックを開くときのイベント
Option Explicit
' ワークブックを閉じる前のイベント(キャンセル可)
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If MsgBox("Workbook_BeforeCloseイベントが発生しました。" & vbCr & _
"キャンセルしますか？", vbInformation + vbYesNo) = vbYes Then
Cancel = True
End If
End Sub
'----------------------------------------------------------------------------------------------------------
' ワークブックを保存する前のイベント(キャンセル可)
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If MsgBox("Workbook_BeforeSaveイベントが発生しました。" & vbCr & _
"キャンセルしますか？", vbInformation + vbYesNo) = vbYes Then
Cancel = True
End If
End Sub
'-----------------------------------------------------------------------------------------------------------
' ワークブックを開く時のイベント
Private Sub Workbook_Open()
ActiveWindow.ScrollRow = 1
MsgBox "Workbook_Openイベントが発生しました。"
End Sub
'---------------------------------------------------------------------------------------
' シートを切り替えるイベント
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
MsgBox "Workbook_SheetActivateイベントが発生しました。" & vbCr & _
"シート名は" & Sh.Name & "です。"
End Sub
'-------------------------------------------------------------------------------------------------
' ウィンドウを切り替えるイベント(自ブックが手前)
Private Sub Workbook_WindowActivate(ByVal Wn As Window)
MsgBox "Workbook_WindowActivateイベントが発生しました。"
End Sub
'----------------------------------------------------------------------------------------------------
' ウィンドウを切り替えるイベント(自ブックが裏)
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
MsgBox "Workbook_WindowDeactivateイベントが発生しました。"
End Sub
'-------------------------------------------------------------------------------------------------------
'《標準モジュールのインポートをVBAで自動化する方法》
Public Sub Sample_ImportModule_01()
' ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
' 参照設定：
' 「Microsoft Visual Basic for Application Extensibility」
' ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
' このブックのVBProjectをオブジェクト変数に格納する。
Public Sub Sample_ImportModule_01()
Dim Obj As VBIDE.VBProject
Set Obj = ThisWorkbook.VBProject
' インポートしたいファイル名を決める。
Dim ImpFile As String
ImpFile = "C:\Users\coco\Desktop\VBFuku\HogeModule.bas .\FugaModule.bas "
' ブック内にモジュールがあるか判別する。
If exists_ImpFile(ImpFile) Then
MsgBox "既に同一モジュールが存在します。", vbExclamation
Else
' このブックにVBAモジュールをインポートします。
Obj.VBComponents.Import ImpFile
End If
' オブジェクトを破棄する。
Set Obj = Nothing
End Sub
' *
' * ブック内にモジュールがあるか判別する関数
' *
Public Function exists_ImpFile( pImpFile As String ) As Boolean
' 戻り値をFalseで初期化する。
exists_ImpFile = False
' FileSystemObjectを生成する。
Dim F As Object
Set F = CreateObject("Scripting.FileSystemObject")
' ファイルのベース名を切り出す。
Dim fileName As String
fileName = F.GetBaseName(pImpFile)
' このブックのVBProjectをオブジェクト変数に格納する。
Dim Obj As VBIDE.VBProject
Set Obj = ThisWorkbook.VBProject
' VBProjectに存在するコンポーネント数を変数に格納する。
Dim CompCnt As Long
CompCnt = Obj.VBComponents.Count
' VBProjectに存在するコンポーネントを一つずつ参照する。
Dim lp As Long
For lp = 1 To CompCnt
' モジュールが既に存在していないか判別する。
If Obj.VBComponents(lp).Name = fileName Then
' 戻り値をTrueにする。
exists_ImpFile = True
GoTo END_JUDGE
End If
Next
END_JUDGE:
' オブジェクトを破棄する。
Set Obj = Nothing
End Function
'-----------------------------------------------------------------------------------------------------------------
- 標準モジュールを削除する方法
Sub CodeDelete()
Dim Obj As Object
For Each Obj In ThisWorkbook.VBProject.VBComponents
With Obj
If .Type = 1 Then
Application.VBE.activeVBProject.VBComponents.Remove Obj
End If
End With
Next Obj
End Sub
'----------------------------------------------------------------------------------------------------------------
コメントをお書きください