| |
HOSHIさん、Jaka さん、こんばんは。
以下のようにしてみました。
標準モジュールに
'================================================================
Sub main()
Dim ret As Long
ret = import_fmcomp(ThisWorkbook, ThisWorkbook.Path & "\frm1.frm")
If ret = 0 Then
MsgBox "good"
Else
MsgBox Error(ret)
End If
End Sub
'=========================================================================
Function import_fmcomp(wk As Workbook, imppath As String) As Long
'機能：指定されたブックに指定されたファイルからフォームモジュールをインポートする
' 尚、インポート対象フォームが既に存在する場合は、既存フォームは削除する
' input : wk --- インポート対象ブック
' imppath--フォームモジュールのインポートファイルのフルパス
' Output: 0----正常インポート
' その他-異常終了
On Error Resume Next
Dim fmnm As String
fmnm = get_formnm(get_forminf_line(imppath))
On Error Resume Next
With wk.VBProject
.VBComponents.Remove .VBComponents(fmnm)
If Err.Number <> 0 Then MsgBox Err.Description
Err.Clear
.VBComponents.Import imppath
import_fmcomp = Err.Number
End With
End Function
'============================================================
Function get_formnm(f_str As String)
'機能：指定された文字列から、フォーム名を抽出する
' input:f_str---フォーム名を含んだ 「Begin {***} Frmnm」形式の文字列
' output:get_formnm---フォーム名
Dim regEx
Set regEx = CreateObject("VBScript.RegExp")
regEx.Pattern = "Begin \{.*\} "
regEx.IgnoreCase = True ' 大文字と小文字を区別しないように設定します。
regEx.Global = True '文字列全体を検索するように設定します。
get_formnm = Trim(regEx.Replace(f_str, "")) '置換を実行します。
Set regEx = Nothing
End Function
'==================================================================
Function get_forminf_line(imppath As String)
'機能：指定されたファイルから、「Begin {***} Frmnm」形式の文字列を取り出す
' input:imppath----インポートファイルのフルパス
' output:get_forminf_line---フォーム名を含んだ 「Begin {***} Frmnm」形式の文字列
Dim flno As Long
Dim dat1 As String
flno = FreeFile()
Open imppath For Input As #flno
Line Input #flno, dat1
Line Input #flno, get_forminf_line
Close #flno
End Function
但し、Excel2002以上では、「ツール」---「マクロ」----「セキュリティ」の
「信頼のおける発行元」タブの「Visual Basicプロジェクトへのアクセスを信頼する」
にチェックを入れないと実行できません。
確認してみてください。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
