Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


50659 / 76732 ←次へ | 前へ→

【30958】Re:ユーザーフォームのインポート
発言  ichinose  - 05/11/7(月) 23:16 -

引用なし
パスワード
   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プロジェクトへのアクセスを信頼する」
にチェックを入れないと実行できません。


確認してみてください。
0 hits

【30940】ユーザーフォームのインポート HOSHI 05/11/7(月) 16:22 質問
【30941】Re:ユーザーフォームのインポート Jaka 05/11/7(月) 16:44 発言
【30958】Re:ユーザーフォームのインポート ichinose 05/11/7(月) 23:16 発言
【30959】Re:ユーザーフォームのインポート 訂正 ichinose 05/11/8(火) 7:57 発言
【30988】Re:ユーザーフォームのインポート 訂正 HOSHI 05/11/8(火) 17:50 質問
【30991】Re:ユーザーフォームのインポート 訂正 ichinose 05/11/8(火) 20:27 発言
【31014】Re:ユーザーフォームのインポート 訂正 HOSHI 05/11/9(水) 10:22 お礼
【31024】Re:ユーザーフォームのインポート 訂正 HOSHI 05/11/9(水) 14:33 お礼
【31043】Re:ユーザーフォームのインポート 訂正 ichinose 05/11/9(水) 20:55 発言
【31058】Re:ユーザーフォームのインポート 訂正 HOSHI 05/11/10(木) 11:49 お礼

50659 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free