[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBSでUserFormを呼び出すとフォルダの後ろに隠れる』（XXX）
行き詰ってしまったので質問させてください。
Excelを開かずUserFormを開く方法としてVBSの存在を知り、見様見真似で次のようなコードを作りました。
VBSコード
Dim objExcel
On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
Set Path = CreateObject("Scripting.FileSystemObject").GetFolder(".")
objExcel.Application.Visible = false
objExcel.Workbooks.Open Path & "\test.xlsm"
objExcel.worksheets("Sheet1").select
objExcel.Application.Run "test1"
Set objExcel = Nothing
VBAコード
Sub test1()
UserForm1.Show vbModeless
End Sub
これでUserForm1は開いてくれたのですが、VBSがあるフォルダの後ろに隠れて開いてしまいます。
開いたUserFormを最前列に持ってくる方法があれば教えてください。
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
UserForm1のモジュール内に以下のコードを追加したらどうでしょう
Private Sub UserForm_Activate()
AppActivate Me.Caption
End Sub
それとこのままだと、起動したExcelを終了するコードがないので、 プロセスが残ってしまうのがまずいと思います。 vbModeless でユーザーフォームをShowしているので、 VBS側でExcelを閉じるのもできないので．．．
UserFormを閉じるボタンに
Private Sub CommandButton1_Click()
Unload Me
Application.Quit
End Sub
としておくくらいでしょうか
（´・ω・`） 2021/10/06(水) 17:04
あんまり良い手が思い付かないデスが...
無理やり最前面ウィンドウとして非アクティブ表示することで、とりあえずユーザーに気付いて貰い、 ユーザーによるActivateで、一応最前面を解除しておく。 で、UserForm_TerminateでExcel終了。と。
Rem [UserForm1] --------------------------------------------------------------------------------------------------------
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal IAcessible As Object, ByRef hwnd As LongPtr) As Long
Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const SW_SHOWNA = 8&
Private Const SWP_NOSIZE = &H1&
Private Const SWP_NOMOVE = &H2&
Private Const SWP_NOZORDER = &H4&
Private Const SWP_NOACTIVATE = &H10&
Private Const SWP_HIDEWINDOW = &H80&
Private Const HWND_TOPMOST = (-1&)
Private Const HWND_NOTOPMOST = (-2&)
Public Property Get hwnd() As Long
WindowFromAccessibleObject Me, hwnd
End Property
Public Sub ShowTopMost()
Static DoneFlg As Boolean
If DoneFlg Then
ShowWindow Me.hwnd, SW_SHOWNA
Exit Sub
End If
DoneFlg = True
Me.Hide '一回これやっとかないとプロシージャ内でNewで作成したインスタンスはExitSubと同時に破棄されてしまう
Dim aRect As RECT, posX As Long, posY As Long
Select Case Me.StartUpPosition
Case 1: GetWindowRect Application.hwnd, aRect
Case 2: GetWindowRect GetDesktopWindow, aRect
End Select
Select Case Me.StartUpPosition
Case 1, 2
posX = aRect.Left + (aRect.Right - aRect.Left) \ 2
posY = aRect.Top + (aRect.Bottom - aRect.Top) \ 2
GetWindowRect Me.hwnd, aRect
posX = posX - (aRect.Right - aRect.Left) \ 2
posY = posY - (aRect.Bottom - aRect.Top) \ 2
SetWindowPos Me.hwnd, HWND_TOPMOST, posX, posY, 0, 0, SWP_NOSIZE Or SWP_HIDEWINDOW Or SWP_NOACTIVATE
End Select
ShowWindow Me.hwnd, SW_SHOWNA
End Sub
Private Sub UserForm_Activate() 'TOPMOST解除
SetWindowPos Me.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub
Private Sub UserForm_Terminate()
Application.Quit
End Sub
Rem 標準モジュール -----------------------------------------------------------------------------------------------------
Sub test1()
UserForm1.ShowTopMost
End Sub
（白茶） 2021/10/06(水) 17:21
ちょっと仰々しすぎました〜^^; ( 他用途コードの使い回しだったもので... ご勘弁 ) アタマ整理し直して、削ぎ落とすと↓こんな感じになりました。
Rem [UserForm1] --------------------------------------------------------------------------------------------------------
Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal IAcessible As Object, ByRef hwnd As LongPtr) As Long
Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const SWP_NOSIZE = &H1&
Private Const SWP_NOMOVE = &H2&
Private Const HWND_TOPMOST = (-1&)
Private Const HWND_NOTOPMOST = (-2&)
Public Property Get hwnd() As LongPtr '←さっきのは[Ptr]が洩れてました
WindowFromAccessibleObject Me, hwnd
End Property
Public Sub ShowTopMost()
Me.Show vbModeless
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE
SetWindowPos Me.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE
End Sub
Private Sub UserForm_Terminate()
Application.Quit
End Sub
Rem 標準モジュール -----------------------------------------------------------------------------------------------------
Sub test1()
UserForm1.ShowTopMost
End Sub
さっきのと違ってタスクバーには表示されませんけど
（白茶） 2021/10/06(水) 22:39
CreateObject("WScript.Shell").AppActivate objExcel.Caption
では？
（BJ） 2021/10/07(木) 00:15
一応補足です。 私のは最前面には来てくれますけど、アクティブにはなりません。表示するだけです。
AppActivateもSetForegroundWindowも失敗するのでSetWindowPosにしてみました。 さらにSetActiveWindow呼んだらイケるかなと思ったんですけどダメだったので、 私もExcel2010/Win7という同じ環境って事も考慮し、最前面表示だけに留めました。
私の勝手な想像では、 AppActivateはプロセス基準でアクティブ化するモノなので UserFormがExcelのプロセスに属してる以上、 Excelをアクティブにした上でUserFormをアクティブにする必要があるけど、 Excelは非表示だからアクティブに出来ず、UserFormもアクティブに出来ない ...という状況なのかなぁ。と、思ってます。
もしそちらの環境でAppActivateが成功するなら、勿論その方がお手軽で良いと思います。
（白茶） 2021/10/07(木) 13:39
意外と単純な手でイケたのでご報告です。(TOPMOST処理無し) 要するに一旦最小化して再度表示し直すという事をやってます。
vbs実行後すぐ(Excel起動してる最中に)ブラウザをアクティブにしてマウスでスクロールしてても UserFormが手前でアクティブに出てきてくれましたよ。
Rem [UserForm1] --------------------------------------------------------------------------------------------------------
Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal IAcessible As Object, ByRef hwnd As LongPtr) As Long
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
Private Const SW_SHOWNORMAL = 1&
Private Const SW_MINIMIZE = 6&
Public Property Get hwnd() As LongPtr
WindowFromAccessibleObject Me, hwnd
End Property
Public Sub Show2()
Me.Show vbModeless
ShowWindow Me.hwnd, SW_MINIMIZE
ShowWindow Me.hwnd, SW_SHOWNORMAL
End Sub
Private Sub UserForm_Terminate()
Application.Quit
End Sub
Rem 標準モジュール -----------------------------------------------------------------------------------------------------
Sub test1()
UserForm1.Show2
End Sub
ちなみに、タスクバーにも表示させたければ↓これでイケました。(ついでにフォームの最小化ボタンも追加)
Rem [UserForm1] --------------------------------------------------------------------------------------------------------
Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal IAcessible As Object, ByRef hwnd As LongPtr) As Long
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
Private Const SW_SHOWNORMAL = 1&
Private Const SW_MINIMIZE = 6&
'追記(ここから)*************
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_EXSTYLE = (-20&)
Private Const WS_EX_APPWINDOW As Long = &H40000
Private Const GWL_STYLE = (-16&)
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_THICKFRAME = &H40000
'追記(ここまで)*************
Public Property Get hwnd() As LongPtr
WindowFromAccessibleObject Me, hwnd
End Property
Public Sub Show2()
Me.Show vbModeless
'追記(ここから)*************
SetWindowLong Me.hwnd, GWL_EXSTYLE, GetWindowLong(Me.hwnd, GWL_EXSTYLE) Or WS_EX_APPWINDOW
SetWindowLong Me.hwnd, GWL_STYLE, GetWindowLong(Me.hwnd, GWL_STYLE) Or WS_MINIMIZEBOX Or WS_THICKFRAME
'追記(ここまで)*************
ShowWindow Me.hwnd, SW_MINIMIZE
ShowWindow Me.hwnd, SW_SHOWNORMAL
End Sub
Private Sub UserForm_Terminate()
Application.Quit
End Sub
（白茶） 2021/10/08(金) 00:50
返信が遅くなってしまい申し訳ありません。
様々な回答ありがとうございました。
たくさんの方法があり、とても勉強になりました。
思っていた通りの動作もしてくれるようになり、助かりました。
重ねて本当にありがとうございました。
（XXX） 2021/10/08(金) 10:35
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.