SetCurrentDirectory関数
VBScriptでオープンダイヤログを開く場合デフォルトで開くフォルダーを指定したい時、指定がネットワークフォルダーだとカレントが対応しないため、これを使って指定します。
構文C++
BOOL SetCurrentDirectory( LPCTSTR lpPathName );
パラメーター
lpPathName
新しい現在のディレクトリへのパス。 このパラメーターは、相対パスまたは完全パスを指定できます
戻り値
関数が失敗した場合、戻り値はゼロです
#If VBA7 And Win64 Then
'64ビット版
Public Declare PtrSafe Function SetCurrentDirectory Lib "Kernel32" Alias _
"SetCurrentDirectoryA" (ByVal CurrentDir As String) As LongPtr
#Else
'32ビット版
Public Declare Function SetCurrentDirectory Lib "Kernel32" Alias _
"SetCurrentDirectoryA" (ByVal CurrentDir As String) As Long
#End If
SendMessage関数
指定されたメッセージを1つまたは複数のウィンドウ（フォーム等）に送信します。
構文C++
LRESULT SendMessage( HWND hWnd, UINT Msg, WPARAM wParam, LPARAM lParam );
パラメーター
hWnd ウィンドウプロシージャがメッセージを受信するウィンドウのハンドル
Msg 送信するメッセージ
WM_DESTROY &h2 ウィンドウが破棄された後、破棄されるウィンドウのウィンドウプロシージャに送信されます 次に子ウィンドウ（存在する場合）が破棄されるときに送信されます。
wParam 使わないので 0
lParam 使わないので 0
WM_MOVE &h3 ウィンドウが移動された後に送信されます
wParam 使わないので 0
lParam クライアント領域の左上隅のxおよびy座標 下位ワードにはx座標が含まれ、上位ワードにはy座標が含まれます
WM_SIZE &h5 ウィンドウのサイズが変更された直後に送信されます
wParam 要求されたサイズ変更のタイプ
lParam 下位ワードは、クライアント領域の新しい幅、上位ワードは、クライアント領域の新しい高さを指定します。
WM_SETTEXT &hc ウィンドウのテキストを設定します
wParam 使わないので 0
lParam ウィンドウテキストである文字列
WM_GETTEXT &hd ウィンドウに対応するテキストを、呼び出し元が提供するバッファーにコピーします
wParam 終端のヌル文字を含む、コピーされる最大文字数
lParam テキストを受け取るバッファー
WM_CLOSE &h10 ウィンドウまたはアプリケーションの終了信号として送信
wParam 使わないので 0
lParam 使わないので 0
WM_SHOWWINDOW &h18
WM_SIZING &h532 ユーザーがサイズ変更しているウィンドウに送信されます このメッセージを処理することにより、アプリケーションはドラッグ長方形のサイズと位置を監視し、必要に応じてサイズまたは位置を変更できます
wParam 要求されたサイズ変更のタイプ
lParam ドラッグ矩形の画面座標を持つRECT構造体
WM_MOVING &h534 ユーザーが移動しているウィンドウに送信されます このメッセージを処理することにより、アプリケーションはドラッグ長方形の位置を監視し、必要に応じてその位置を変更できます
wParam 使わないので 0
lParam 画面座標でのウィンドウの現在の位置を持つRECT構造体
wParam 追加のメッセージ固有の情報
lParamn 追加のメッセージ固有の情報
戻り値
送信されるメッセージに依存します
'VBAで使うことを目的としているのでlPlamはMsgに応じてAny型、String型とします
#If VBA7 And Win64 Then
Public Declare Function SendMessageA Lib "user32" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
#Else
Public Declare PtrSafe Function SendMessageA Lib "user32" _
(ByVal hWnd As LongPtr, _
ByVal wMsg As Long, _
ByVal wParam As LongPtr, _
lParam As Any) As LongPtr
#End If
'MsgがWM_SETTEXT、WM_GETTEXTの場合
#If VBA7 And Win64 Then
Public Declare Function SendMessageA Lib "user32" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As String) As Long
#Else
Public Declare PtrSafe Function SendMessageA Lib "user32" _
(ByVal hWnd As LongPtr, _
ByVal wMsg As Long, _
ByVal wParam As LongPtr, _
lParam As String) As LongPtr
#End If
GetWindowLongA関数・GetWindowLongPtreA関数
指定されたウィンドウに関する情報を取得します。
Windowsの32ビットと64ビットの両バージョンと互換性のあるコードを作成するには、GetWindowLongPtrを使用します
構文C++
LONG GetWindowLongA( HWND hWnd, int nIndex );
LONG_PTR GetWindowLongPtrA( HWND hWnd, int nIndex );
パラメータ
hWnd ウィンドウのハンドル
nIndex 取得する値へのゼロベースのオフセット
GWL_EXSTYLE -20& 拡張ウィンドウスタイルを取得します
GWLP_HINSTANCE -6& アプリケーションインスタンスへのハンドルを取得します
GWLP_HWNDPARENT -8& 親ウィンドウへのハンドルがあれば、それを取得します
GWLP_ID -12& ウィンドウの識別子を取得します
GWL_STYLE -16& ウィンドウスタイルを取得します
GWLP_USERDATA -21& ウィンドウに関連付けられたユーザーデータを取得します
GWLP_WNDPROC -4& ウィンドウプロシージャへのポインタ、またはハンドルを取得します
注）&はVBで用意される型文字で、Longデータ型を表します
型文字は、要素の名前の一部ではありません
型文字で定義された要素は、型文字を使用せずに参照できます
戻り値
成功した場合、戻り値は要求された値です。
関数が失敗した場合、戻り値はゼロです
#If VBA7 Then
#If Win64 Then
Private Declare PtrSafe Function GetWindowLongPtr _
Lib "USER32" Alias "GetWindowLongPtrA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long) As LongPtr
#Else
Private Declare PtrSafe Function GetWindowLongPtr _
Lib "USER32" Alias "GetWindowLongA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long) As LongPtr
#End If
#Else
Private Declare Function GetWindowLongPtr _
Lib "USER32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
#End If
SetWindowLongA関数・SetWindowLongPtreA関数
指定されたウィンドウの属性を変更します また、指定されたオフセットにある32ビット（長い）値を追加のウィンドウメモリに設定します。 Windowsの32ビットと64ビットの両バージョンと互換性のあるコードを作成するには、SetWindowLongPtrを使用します
構文C++
LONG SetWindowLongA( HWND hWnd, int nIndex, LONG dwNewLong );
LONG_PTR SetWindowLongPtrA( HWND hWnd, int nIndex, LONG_PTR dwNewLong );
パラメータ
hWnd ウィンドウのハンドル
nIndex 取得する値へのゼロベースのオフセット
GWL_EXSTYLE -20& 新しい拡張ウィンドウスタイルを設定します 。
GWL_HINSTANCE -6& 新しいアプリケーションインスタンスハンドルを設定します。
GWL_ID -12& 子ウィンドウの新しい識別子を設定します。 ウィンドウをトップレベルのウィンドウにすることはできません。
GWL_STYLE -16& 新しいウィンドウスタイルを設定します 。
GWL_USERDATA -21& ウィンドウに関連付けられたユーザーデータを設定します。 このデータは、ウィンドウを作成したアプリケーションが使用するためのものです。 その値は最初はゼロです。
GWL_WNDPROC -4& ウィンドウプロシージャの新しいアドレスを設定します
（注）&はVBで用意される型文字で、Longデータ型を表します
型文字は、要素の名前の一部ではありません
型文字で定義された要素は、型文字を使用せずに参照できます
dwNewLong 以下の値を組み合わせた置換値
WS_BORDER &h800000 細い線の境界線を表示します
WS_CAPTION &hC00000 タイトルバーを表示します（WS_BORDERスタイルを含む）
WS_CHILD &h40000000 子ウィンドウにします メニューバーは使用不可で、WS_POPUPスタイルと併用できません
WS_CHILDWINDOW &h40000000 WS_CHILDスタイルと同じです
WS_CLIPCHILDREN &h2000000 親ウィンドウ内で描画が行われるときに、子ウィンドウが占める領域を除外します
WS_CLIPSIBLINGS &h4000000 子ウィンドウを相互にクリップします
WS_DISABLED &h8000000 無効なウィンドウにします
WS_DLGFRAME &h400000 ダイアログボックスで通常使用されるスタイルの境界線を表示し、タイトルバーを設定できません
WS_GROUP &h20000 コントロールのグループの最初のコントロールです
WS_HSCROLL &h100000 水平スクロールバーを表示します
WS_ICONIC &h20000000 最小化します
WS_MAXIMIZE &h1000000 最大化します
WS_MAXIMIZEBOX &h10000 最大化ボタンを表示します WS_SYSMENUも指定する必要があります
WS_MINIMIZE &h20000000 最小化します
WS_MINIMIZEBOX &h20000 最小化ボタンを表示します WS_SYSMENUも指定する必要があります
WS_OVERLAPPED &h0 オーバーラップウィンドウは、タイトルバーと境界線を表示します
WS_OVERLAPPEDWINDOW WS_OVERLAPPED | WS_CAPTION | WS_SYSMENU | WS_THICKFRAME | WS_MINIMIZEBOX | WS_MAXIMIZEBOX
オーバーラップウィンドウです
WS_POPUP &h80000000 ポップアップウィンドウです WS_CHILDスタイルと併用できません
WS_POPUPWINDOW WS_POPUP | WS_BORDER | WS_SYSMENU
ポップアップウィンドウです ウィンドウメニューを表示するには、 WS_CAPTIONとWS_POPUPWINDOWを組み合わせる必要があります
WS_SIZEBOX &h40000 サイズ変更境界線があります
WS_SYSMENU &h80000 タイトルバーにはウィンドウメニューを表示します WS_CAPTIONも指定する必要があります
WS_TABSTOP &h10000 Tabキーを押したときにキーボードフォーカスを受け取ることができるコントロールです
WS_THICKFRAME &h40000 サイズ変更境界線があります
WS_TILED &h0 タイトルバーと境界線を表示します
WS_TILEDWINDOW WS_OVERLAPPED | WS_CAPTION | WS_SYSMENU | WS_THICKFRAME | WS_MINIMIZEBOX | WS_MAXIMIZEBOX
オーバーラップウィンドウです
WS_VISIBLE &h10000000 ウィンドウを表示します
WS_VSCROLL &h200000 垂直スクロールバーを表示します
戻り値
成功した場合、戻り値は指定された32ビット整数の以前の値です
関数が失敗した場合、戻り値はゼロです
#If VBA7 Then
#If Win64 Then
Private Declare PtrSafe Function GetWindowLongPtr _
Lib "USER32" Alias "GetWindowLongPtrA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long) As LongPtr
#Else
Private Declare PtrSafe Function GetWindowLongPtr _
Lib "USER32" Alias "GetWindowLongA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long) As LongPtr
#End If
#Else
Private Declare Function GetWindowLongPtr _
Lib "USER32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
#End If
MessageBox関数
MessageBox 関数は VBA の MsgBox 関数に相当するものです。
'hWnd :ウィンドウのハンドルを指定します。
'lpText :メッセージボックス内のテキストを指定します。
'lpCaption :メッセージボックスのタイトルを指定します。
'uType :メッセージボックスのスタイル
'戻り値 :選択したボタンを数値でかえす。
Public Declare PtrSafe Function MessageBox Lib "user32.dll" Alias "MessageBoxA" _
(ByVal hWnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal uType As Integer) As Integer
FindWindow関数
'lpClassName :NULL で終わる文字列へのポインタか、クラスアトムを指定します。
'lpWindowName :ウィンドウ名（ ウィンドウのタイトル）が入ったNULLで終わる文字列へのポインタを指定します。
'戻り値 :成功すると指定したクラス名とウィンドウ名を持つウィンドウのハンドル、失敗すれば0がかえる。
#If VBA7 And Win64 Then
Private Declare PtrSafe Function FindWindow _
Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
#Else
Private Declare Function FindWindow
Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
#End If
FindWindowEx関数
'hwndParent :親ウィンドウのハンドル
'hwndChildAfter :子ウィンドウのハンドル
'lpszClass :クラス名
'lpszWindow :ウィンドウ名
#If VBA7 And Win64 Then
Private Declare PtrSafe Function FindWindowEx _
Lib "USER32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, _
ByVal hWnd2 As LongPtr, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As LongPtr
#Else
Private Declare Function FindWindowEx _
Lib "USER32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
#End If
SetTimer関数
'HWND hWnd : ウィンドウのハンドル
'nIDEvent :タイマの識別子
'uElapse :タイムアウト値
'lpTimerFunc :タイマのプロシージャ
Public Declare PtrSafe Function SetTimer Lib "user32" _
(ByVal hWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As LongPtr) As Long
'-----------------------------------------------
'hWnd :ウィンドウのハンドル
'uIDEvent :タイマの識別子
Public Declare PtrSafe Sub KillTimer Lib "user32" _
(ByVal hWnd As Long, _
ByVal nIDEvent As Long)
メニューの表示関係
'---------------------------------------ウィンドウスタイルを決定するフラッグ
Public Const WS_SYSMENU = &H80000 'タイトルバーにコントロールメニューボックスを持つウィンドウ
'---------------------------------------システムメニューのハイライト表示のフラッグ
Public Const MF_BYCOMMAND = &H0&
'---------------------------------------システムメニューのWM_SYSCOMMANDメッセージに設定されるフラッグ
Public Const SC_MINIMIZE = &HF020&
Public Const SC_MAXIMIZE = &HF030&
Public Const SC_CLOSE = &HF060&
Public Const SC_RESTORE = &HF120&
'--------------------------------------------------------------------------
'ウィンドウメニュー(システムメニューまたはコントロールメニューとも呼ばれる)のハンドルを取得する関数
'hWnd :ウィンドウメニューを保持しているウィンドウのハンドルを指定します。
'bRevert :関数の動作を指定します。
'戻り値 :bRevert パラメータがFALSEの場合、ウィンドウメニューが内部でコピーされ、
' コピー先のメニューハンドルが返ります。bRevertパラメータが TRUE の場合、NULLが返ります。
Public Declare PtrSafe Function GetSystemMenu Lib "user32" _
(ByVal hWnd As Long, _
ByVal bRevert As Long) As Long
'--------------------------------------------------------------------------
'メニューからメニュー項目を削除する関数
'hMenu :削除対象のメニューのハンドルを指定します。
'nPosit :削除対象のメニュー項目を指定します。
'wFlags :uPosition パラメータの意味を指定します。
'戻り値 :成功すれば 1、失敗すれば 0 がかえる。
Public Declare PtrSafe Function DeleteMenu Lib "user32" _
(ByVal hMenu As Long, _
ByVal nPosition As Long, _
ByVal wFlags As Long) As Long
'--------------------------------------------------------------------------
'ウィンドウのメニューバーを再描画する関数
'hWnd :メニューバーを再描画するべき 1 つのウィンドウのハンドルを指定します。
'戻り値 :成功すれば1、失敗すれば0がかえる。
#If VBA7 Then
Public Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long
#Else
Public Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
#End If
ShellExecuteA関数
fileOPENは、拡張子に関連付けされたアプリケーションで開きます。URLであればブラウザで開きます。
構文C++
HINSTANCE ShellExecuteA( HWND hwnd, LPCSTR lpOperation, LPCSTR lpFile, LPCSTR lpParameters, LPCSTR lpDirectory, INT nShowCmd );
パラメーター
Hwnd 親ウィンドウのハンドル
lpOperation 実行するアクションを指定する文字列
"open" 指定したファイルを開きます
"Print" 指定したファイルを印刷します(文書ファイルのみ)
"explore" 指定したフォルダをエクスプローラで開きます
"Edit" 指定したフォルダをエディターを起動し､ドキュメントを編集用に開きます(文書ファイルのみ)
lpFile ファイルパス文字列
lpParameters 実行可能ファイルを指定する場合､アプリケーションに渡すパラメーターを指定する
lpDirectory 作業ディレクトリの指定､この値がNULLの場合､現在の作業ディレクトリが使用されます
nShowCmd アプリケーションが開かれたときに表示される方法を指定するSW_フラグ
SW_HIDE 0& ウィンドウを非表示にして、別のウィンドウをアクティブにします
SW_MAXIMIZE 3& 指定されたウィンドウを最大化します
SW_MINIMIZE 6& 指定されたウィンドウを最小化し、zオーダーの次のトップレベルウィンドウをアクティブにします
SW_RESTORE 9& ウィンドウをアクティブにして表示して、ウィンドウが最小化または最大化されている場合、元のサイズと位置に復元します
SW_SHOW 5& ウィンドウをアクティブにし、現在のサイズと位置で表示します
SW_SHOWDEFAULT 10& STARTUPINFO構造体で指定されたSW_フラグに基づいて、表示状態を設定します
SW_SHOWMAXIMIZED 3& ウィンドウをアクティブにして、最大化して表示します
SW_SHOWMINIMIZED 2& ウィンドウをアクティブにして、最小化して表示します
SW_SHOWMINNOACTIVE 7& ウィンドウを最小化されたウィンドウとして表示します
SW_SHOWNA 8& ウィンドウを現在の状態で表示します
SW_SHOWNOACTIVATE 4& ウィンドウを最新のサイズと位置で表示します
パラメーター
関数が成功した場合､32より大きい値を返します｡ 関数が失敗した場合､失敗の原因を示すエラー値を返します
#If VBA7 And Win64 Then
'64ビット版
Public Declare PtrSafe Function ShellExecute _
Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As LongPtr, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As LongPtr
#Else
'32ビット版
Public Declare Function ShellExecute _
Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
#End If
GetDesktopWindow関数
デスクトップウィンドウのハンドルを取得します。デスクトップウィンドウはスクリーン全体を覆っており、この上にアイコンやウィンドウなどが描画されます。
#If VBA7 And Win64 Then
'64ビット版
Public Declare PtrSafe Function GetDesktopWindow Lib "USER32" () As LongPtr
#Else
'32ビット版
Public Declare Function GetDesktopWindow Lib "USER32" () As Long
#End If
Message
下記の標準モジュールの名前です。いろいろなWinAPI32の関数を数多く使用しています。使い方が集約されていますので、参考になります。
Private Sub CommandButton1_Click()
'-----ボタンのキャプション、戻り値をセット
Message.ID = 0
Message.Title = "検索エンジンの選択"
Message.Item1 = "Google"
Message.Item2 = "DuckDuckGo"
Message.Item3 = "Yahoo"
Message.Res1 = "http://www.google.co.jp/"
Message.Res2 = "https://duckduckgo.com/"
Message.Res3 = "http://www.yahoo.co.jp/"
If Not fileOPEN(myMsgBox) Then
MsgBox "開くことができません"
End If
End Sub
最初クラスを作ろうとして、 SetTimer のコールバック関数を AddressOf TimerProc で指定しましたが、EXCEL から「 AddressOf 演算子の使い方が正しくありません」と警告されてしましました。調べてみると「クラス メソッドの名前に AddressOf を使用しようとしました。 AddressOf で変更できるのは、 .bas モジュール内の Visual Basic プロシージャの名前のみです。クラス メソッドを指定することはできません。」（https://msdn.microsoft.com/ja-jp/vba/language-reference-vba/articles/invalid-use-of-addressof-operator)とのことでした。それで、このような形にしました。 Copy to clipboard
Option Explicit
'----------------------------------------------------------------------
Private LngID As Long
Private mTitle As String
Private mItem1 As String
Private mItem2 As String
Private mItem3 As String
Private mRes1 As Variant
Private mRes2 As Variant
Private mRes3 As Variant
'----------------------------------------------------------------------
Public Property Let ID(ByVal Val As Long)
LngID = Val
End Property
Public Property Let Title(ByVal Val As String)
mTitle = Val
End Property
Public Property Let Item1(ByVal Val As String)
mItem1 = Val
End Property
Public Property Let Item2(ByVal Val As String)
mItem2 = Val
End Property
Public Property Let Item3(ByVal Val As String)
mItem3 = Val
End Property
Public Property Let Res1(ByVal Val As String)
mRes1 = Val
End Property
Public Property Let Res2(ByVal Val As String)
mRes2 = Val
End Property
Public Property Let Res3(ByVal Val As String)
mRes3 = Val
End Property
'----------------------------------------------------------------------
Private Sub Initialize()
If IsEmpty(LngID) Then LngID = 0
If IsEmpty(mTitle) Then mTitle = "確認"
If IsEmpty(mItem1) Then mItem1 = "確認"
If IsEmpty(mItem2) Then mItem2 = ""
If IsEmpty(mItem3) Then mItem3 = ""
If IsEmpty(mRes1) Then mRes1 = vbOK
If IsEmpty(mRes2) Then mRes2 = ""
If IsEmpty(mRes3) Then mRes3 = ""
End Sub
'----------------------------------------------------------------------
Public Function myMsgBox() As Variant
Dim iCount As Long
Dim Buttons As Variant
Dim lngRtn As Long
Dim varBUF As Variant
Call Initialize
'-----キャプションの調整
iCount = 0
If mItem1 <> "" And mRes1 <> "" Then
iCount = iCount + 1
End If
If mItem2 <> "" And mRes2 <> "" Then
iCount = iCount + 1
If iCount = 1 Then
mItem1 = mItem2
mRes1 = mRes2
mItem2 = ""
mRes2 = ""
End If
End If
If mItem3 <> "" Or mRes3 <> "" Then
iCount = iCount + 1
If iCount = 1 Then
mItem1 = mItem3
mRes1 = mRes3
mItem3 = ""
mRes3 = ""
ElseIf iCount = 2 Then
mItem2 = mItem3
mRes2 = mRes3
mItem3 = ""
mRes3 = ""
End If
End If
'-----ボタンのキャプションの数に応じてボタンを指定する
If iCount = 3 Then
Buttons = vbYesNoCancel
ElseIf iCount = 2 Then
Buttons = vbYesNo
ElseIf iCount = 1 Then
Buttons = vbOK
End If
'-----タイマーをスタート
Call Timer_Start
'-----メッセージボックスを開きます
lngRtn = MessageBox(Application.hWnd, "検索エンジンを選択してください", mTitle, Buttons)
Select Case lngRtn
Case vbYes
varBUF = mRes1
Case vbNo
varBUF = mRes2
Case vbCancel
varBUF = mRes3
Case vbOK
varBUF = mRes1
End Select
'-----値を返す
myMsgBox = varBUF
End Function
'----------------------------------------------------------------------
Public Sub TimerProc(ByVal hWnd As LongPtr, _
ByVal uMsg As Long, _
ByVal idEvent As Long, _
ByVal dwTime As Long)
Dim dlghWnd As Long
Dim btn1hWnd As Long
Dim btn2hWnd As Long
Dim btn3hWnd As Long
Timer_End 'タイマーを切ります
'-----実行時エラーが発生してもプログラムを中断せず、次のステートメントから実行を継続
On Error Resume Next
'-----システムボックスを非表示にします
Call LsSetWindowLong(mTitle, "無効")
'-----［閉じる］ボタンを無効にする
Call LsDeleteMenu(mTitle, "無効")
'dlghWnd = FindWindow("#32770", mTitle)
dlghWnd = FindWindowEx(0&, 0&, "#32770", mTitle)
'-----［はい］ボタンの表示を変更する
btn1hWnd = FindWindowEx(dlghWnd, 0&, "Button", "はい(&Y)")
If btn1hWnd <> 0& Then
Call SendMessage(btn1hWnd, WM_SETTEXT, 0, ByVal mItem1)
'Call SetWindowText(btn1hWnd, mItem1) でも可
End If
'-----［いいえ］ボタンの表示を変更する
btn2hWnd = FindWindowEx(dlghWnd, 0&, "Button", "いいえ(&N)")
If btn2hWnd <> 0& Then
Call SendMessage(btn2hWnd, WM_SETTEXT, 0, ByVal mItem2)
'Call SetWindowText(btn2hWnd, mItem2) でも可
End If
'-----［キャンセル］ボタンの表示を変更する
btn3hWnd = FindWindowEx(dlghWnd, 0&, "Button", "キャンセル")
If btn3hWnd <> 0& Then
Call SendMessage(btn3hWnd, WM_SETTEXT, 0, ByVal mItem3)
'Call SetWindowText(btn3hWnd, mItem3) でも可
End If
End Sub
'----------------------------------------------------------------------
Private Sub Timer_Start()
If LngID = 0 Then
LngID = SetTimer(0&, 0&, 0&, AddressOf TimerProc)
End If
End Sub
'----------------------------------------------------------------------
Private Sub Timer_End()
If LngID <> 0 Then
Call KillTimer(0&, LngID)
LngID = 0
End If
End Sub
'----------------------------------------------------------------------
'コントロールメニューを有効/無効
Private Sub LsSetWindowLong(strCaption As String, FLG As String)
Dim hWnd As Long
Dim lngGetWindowLong As Long
'-----ウィンドウのハンドルを取得（vbNullString：VBAで定義された定数 値 0 を持つ文字列）
hWnd = FindWindow(vbNullString, strCaption)
'-----ウィンドウに関する情報を取得
lngGetWindowLong = GetWindowLong(hWnd, GWL_STYLE)
If FLG = "無効" Then
lngGetWindowLong = lngGetWindowLong And (Not WS_SYSMENU)
Else
lngGetWindowLong = lngGetWindowLong Or WS_SYSMENU
End If
'-----ウィンドウの属性を変更
Call SetWindowLong(hWnd, GWL_STYLE, lngGetWindowLong)
End Sub
'----------------------------------------------------------------------
'コントロールメニュー［×］ボタンを有効/無効
Private Sub LsDeleteMenu(strCaption As String, FLG As String)
Dim hWnd As Long
Dim hMenu As Long
'-----ウィンドウのハンドルを取得（vbNullString：VBAで定義された定数 値 0 を持つ文字列）
hWnd = FindWindow(vbNullString, strCaption)
If FLG = "無効" Then
'-----ウィンドウに関する情報を取得
hMenu = GetSystemMenu(hWnd, 0&)
'-----［閉じる］ボタンを無効にする
Call DeleteMenu(hMenu, SC_CLOSE And SC_MINIMIZE And SC_RESTORE, MF_BYCOMMAND)
Else
'-----ウィンドウメニューをリセットする
hMenu = GetSystemMenu(hWnd, 1&)
End If
'-----ウィンドウのメニューバーを再描画
Call DrawMenuBar(hWnd)
End Sub
fileOPENは、拡張子に関連付けされたアプリケーションで開きます。URLであればブラウザで開きます。
構文C++
fileOPENは、拡張子に関連付けされたアプリケーションで開きます。URLであればブラウザで開きます。