連携 他のブックのSub・Functionステートメントを実行する

VB&VBA
FROG ふろっぐ
 
  • オプション

    本文印刷

    お気に入りに追加

  • 検索

    Googlewwwjp-ia
     

    Googlewwwjp-ia
     
  • 情報

  • 関連

[VB&VBA][連携 他のブックのSub・Functionステートメントを実行する]
Option Explicit


Sub OthersBookSub(strPath As String, FileName As String, ModuleName As String _
, StatementName As String)
'****************************************
'他のブックのSubステートメントを実行する
'****************************************
'※使用するブックは開かれているものとする
'strPath:       呼び出すブックのパス(C:\など)
'FileName:      呼び出すブック名(パスは不要・.xlsは必要)
'ModuleName:    呼び出すモジュール名(Module1など)
'StatementName: 呼び出すSubステートメント名(Testなど)

Dim bk As Workbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set bk = Workbooks.Open(strPath & FileName)

Application.Run FileName & "!" & ModuleName & "." & StatementName

bk.Close SaveChanges:=False

Set bk = Nothing

Application.ScreenUpdating = True
Application.DisplayAlerts = True

'使用例
'(各項目を変数で記述する場合)
'Application.Run NewBok.Name & "!" & "Module5" & "." & "ExcelSheetAllProtect"
'(直接記述)
'Application.Run "NewBok.xls!Module5.ExcelSheetAllProtect"

'※実際はこのような2重な使い方はしません。
End Sub


Function OthersBookFun(strPath As String, FileName As String, ModuleName As String _
, StatementName As String, vrn As VariantAs Variant
'**********************************************
'他のブックのFunctionステートメントを実行する
'**********************************************
'※使用するブックは開かれているものとする
'strPath:       呼び出すブックのパス(C:\など)
'FileName:      呼び出すブック名(パスは不要)
'ModuleName:    呼び出すモジュール名
'StatementName: 呼び出すFunctionステートメント名
'vrn:           呼び出すFunctionステートメントの引数
Dim bk As Workbook, vr As Variant

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set bk = Workbooks.Open(strPath & FileName)

vr = _
Application.Run(FileName & "!" & ModuleName & "." & StatementName, vrn)

bk.Close SaveChanges:=False
Set bk = Nothing

Application.ScreenUpdating = True
Application.DisplayAlerts = True
OthersBookFun = vr

'使用例は上記参照

'※実際はこのような2重な使い方はしません。
End Function


Private Sub test()
Dim sht As Worksheet, strad As String, Lad As String
Dim XlsName As String
XlsName = "test.xls"
Set sht = ThisWorkbook.Worksheets("test")

With sht
    strad = .Cells(.Cells(65536, 4).End(xlUp).Row, 2).Value
End With

Lad = ServerAddressLocal(strad) & "\"
OthersBookSub Lad, XlsName, "testModule", "testsub"
End Sub







Production Japan Import Application. Since 1998