3
3

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

EXCEL VBA:外部アプリを起動したり閉じたりするためのクラスモジュール

Last updated at Posted at 2020-08-17

WinAPIの本を読んだので、練習がてら作成してみました。

外部アプリを操作するコード(クラスモジュール)

Option Explicit
'クラス名またはキャプションからウィンドウハンドルを取得する
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

'指定ウィンドウにメッセージを送る
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As LongPtr, ByVal wParam As LongPtr, ByRef lParam As Any) As LongPtr
Private Const WM_SYSCOMMAND = &H112 
Private Const SC_CLOSE = &HF060& 

'指定ウィンドウをトップ位置に移動しアクティブにする
Private Declare PtrSafe Sub SetForegroundWindow Lib "user32" (ByVal hwnd As LongPtr)

'モジュール変数、定数
Private m_className As String

'指定アプリのクラス名を取得する
Public Property Let SetAppClassName(ByVal a_className As String)
    m_className = a_className
End Property

'指定アプリが起動していなかったら起動する
Public Sub BootAppByWinApi()
    Dim isBoot As Boolean: isBoot = CBool(FindWindow(m_className, vbNullString)) '既に起動していた場合True
    If Not isBoot Then Call Shell(m_className, vbNormalFocus) '起動していなかったら、アプリを起動する
End Sub

'指定したアプリを全て閉じる
Public Sub CloseAppByWinApi()
    
    'ウィンドウハンドルを取得
    Dim hwnd  As LongPtr: hwnd = FindWindow(m_className, vbNullString)
    'ウィンドウハンドルを取得できた場合True
    Dim isBoot As Boolean: isBoot = CBool(hwnd)
        
    '指定アプリのウィンドウを全て閉じるまでループ
    Do While isBoot
        Call SendMessage(hwnd, WM_SYSCOMMAND, SC_CLOSE, 0) 'ウィンドウを閉じる
        hwnd = FindWindow(m_className, vbNullString) '次のウィンドウハンドルを取得する
        isBoot = CBool(hwnd) 'ウィンドウハンドルを取得できた場合True
    Loop

End Sub

'指定したアプリのウィンドウを最前面に表示する
Sub MakeAppForegroundByWinApi()
      
    Dim hwnd As LongPtr: hwnd = FindWindow(m_className, vbNullString)
    Dim isBoot As Boolean: isBoot = CBool(hwnd)
    
    '指定アプリが起動していたら、最前面に表示する
    If isBoot Then Call SetForegroundWindow(hwnd)
    
End Sub

動作確認用コード①
起動中のIE、Chrome、フォルダを閉じる。

Sub CloseApp()
    
    Dim myAppOperation As AppOperation: Set myAppOperation = New AppOperation
    '操作するアプリのクラス名をセット
    Dim nameApp() As String: nameApp() = SetClassName
     
    '指定アプリを閉じる
    Dim indexApp As Long
    For indexApp = LBound(nameApp) To UBound(nameApp)
        myAppOperation.SetAppClassName = nameApp(indexApp)
        myAppOperation.CloseAppByWinApi
    Next indexApp
    
    'Excelを最前面に表示する
    myAppOperation.SetAppClassName = "XLMAIN"
    myAppOperation.MakeAppForegroundByWinApi
    MsgBox ("Normal Termination")

End Sub

Function SetClassName() As String()

    Dim nameApp() As String
     
    '操作するアプリのクラス名を配列にセット
    ReDim nameApp(1 To 3)
    nameApp(1) = "IEFrame"
    nameApp(2) = "Chrome_WidgetWin_1"
    nameApp(3) = "CabinetWClass"
    
    SetClassName = nameApp

End Function

動作確認用コード②
メモ帳を起動して閉じる

Sub OperateNotepad()

    Dim notepadOperation As AppOperation: Set notepadOperation = New AppOperation
    notepadOperation.SetAppClassName = "Notepad"
    notepadOperation.BootAppByWinApi
    notepadOperation.MakeAppForegroundByWinApi
    notepadOperation.CloseAppByWinApi

End Sub
3
3
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
3
3

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?