Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : その他)
ブレークポイント後やメッセージボックスでOK押下後でないとSetForegroundWindowでアクティブにならない
投稿日時: 21/10/28 17:24:13
投稿者: Alice

Microsoft Excel for Microsoft 365 MSOを使用しています。
 
別アプリケーションをアクティブにする為に、SetForegroundWindowを使用していますが通しで実行するとアクティブにならず、下記のような一旦手動をはさむとアクティブになります。
 
・SetForegroundWindowにブレークポイントで止めた後、手動でF5キーを押して再開
・SetForegroundWindow前にメッセージボックスを入れ、表示されたメッセージボックスのOKをクリック
 
ブレークポイントで止めた後、コードの変更も何もせず再開すると正しく動作されるので、コードになんらかの原因があると思えず、手詰まりになっています。
 
(処理が進み過ぎるのが原因とも考えて、sleepを合間に入れていますが効果なしでした。)
 
何かお知恵をお持ちの方がいらっしゃいましたら、アドバイスを下さると幸いです。
宜しくお願い致します。
 
なお、コードは下記のとおりです。
(いくつかの変数は別のモジュールから取得)
 

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Declare PtrSafe Function SetForegroundWindow Lib "user32" _
(ByVal hwnd As Long) As Long

Sub rateTable_PDF()

Dim wsh As Object 'デスクトップパスを取得する為の変数 「参照設定」でWindows Script Host Object Modelにチェック必要
Set wsh = CreateObject("WScript.Shell")

Dim appWord As Object
Dim task As Variant

Dim CaptionName As String
Dim myHwnd As Variant

Dim desktop_path As String
Dim fso As New FileSystemObject 'ファイルを移動するのに必要

'***********************************************************************
'該当期の対象月のレートファイルの該当期のシートを選択し、CubePDFでPDF化
'***********************************************************************
    
    Windows(RateWB_name).Activate

    'シート名に余白が入っていることがある為、引っかからなかったら空白ありシート名で検索後シート選択
    On Error Resume Next
    
    Sheets(gaitoh_ki & "期").Select
    
        If Err.Number = 9 Then
        
            Sheets(gaitoh_ki & "期 ").Select
        
        End If
        
            '「B1」、「I1」セルに入力するが、Obic作業時にこのファイルの上書き保存をする為、ここで上書き保存していなくても大丈夫
            '「B1」セルは作業日の1日付
            Range("B1") = y & "/" & m & "/1"
            
            '「J1」セルは作業日の日時
            Range("J1") = Now
            
            '「VND」列に事前に取得したTTM値を入れる
                    '入力する該当セル位置取得
                    Cells.Find(what:="年/月", lookat:=xlWhole).Select
                    
                    title_col = Selection.Column
                    title_row = Selection.Row
                    
                            Do
                                Selection.Offset(1, 0).Select
                                
                                If InStr(Selection, y & "/" & m2keta) > 0 Then
                                
                                   VND_row = Selection.Row
                                   
                                   Exit Do
                                End If
                            Loop
                    
                    Rows(title_row).Find(what:=VND_chara, lookat:=xlWhole).Select 'VNDがある列番号取得
                    
                    VND_col = Selection.Column
  
              Cells(VND_row, VND_col) = VND_TTM
 
                print_name = Application.ActivePrinter '現在使用しているプリンター名を取得する
                
                ActiveWindow.SelectedSheets.PrintOut ActivePrinter:="CubePDF" 'cubePDFで印刷
                 
                Application.ActivePrinter = print_name '現在使用しているプリンター名を元に戻す
                
                     'pdf用のファイル名作成するのに、拡張子を削除
                     RateWB = Left(RateWB, InStrRev(RateWB, ".") - 1)
                     '拡張子をpdfに変更
                     RateWB = RateWB & ".pdf"
                     
                        '★CubePDFのクラス名を取得★------------------------------------

                        Set appWord = CreateObject("Word.Application")

                            For Each task In appWord.Tasks                   'Word VBAのTasksコレクションを調べる(この機能はWordにしかない)
    
                                If task.Visible = True And InStr(task.Name, "CubePDF") > 0 Then      'タスク(プロセス)が実行中でキャプションに「CubePDF」が含まれていたらキャプション名取得
                                    CaptionName = task.Name
                                    Exit For
                                End If
                                
                            Next
    
                        appWord.Quit
                        Set appWord = Nothing
                       '-----------------------------------------------------------------
                       
                         'クリップボードにPDFのフルパスを記憶
                        'With CB
                        '    .SetText RateWB
                        '    .PutInClipboard
                        'End With
                        
                    'CubePDFウィンドウが開いたか確認
                    Do
                      myHwnd = FindWindow(vbNullString, CaptionName) '上記で取得したキャプションを元にウィンドウを探す
                                                                                                       
                    Loop While myHwnd = 0
                    
                        Sleep 3000
                    
                    SetForegroundWindow myHwnd    'CubePDFのウィンドウをアクティブ化
                         'ここでブレークポイントを入れて、再開すると正常動作する
    
                        With CreateObject("Wscript.Shell")  'マクロだとCubePDF上で保存先パスがペーストされずデフォルトのままなので、指定パスへ移動させる
                            .SendKeys "{TAB}"
                             .SendKeys "{TAB}"
                             .SendKeys "{TAB}"
                             .SendKeys "{TAB}"
                             .SendKeys "{TAB}"
                            '.SendKeys "^v" 'クリップボードに記憶したPDFのフルパスをペースト
                            .SendKeys "{ENTER}"
                         End With
                         
                         Sleep 3000
                      
                  'デスクトップパスを取得(CubePDFの初期設定ではデスクトップに変換したファイルを保存する為)
                  'https://clown.cube-soft.jp/entry/cubepdf/application-settings#%E4%B8%80%E8%88%AC
                  
                  desktop_path = wsh.SpecialFolders("Desktop")

                  PDF_currentPath = desktop_path & Mid(RateWB, InStrRev(RateWB, "\"))
                  
                  'CubePDFのデフォルトパスに保存されたPDFを本来の保存先へ移動する
                  fso.MoveFile PDF_currentPath, RateWB
                  
                  Set fso = Nothing

End Sub

 

回答
投稿日時: 21/10/28 18:00:14
投稿者: sk

引用:
別アプリケーションをアクティブにする為に、SetForegroundWindowを
使用していますが通しで実行するとアクティブにならず、下記のような
一旦手動をはさむとアクティブになります。

引用:
Do
  myHwnd = FindWindow(vbNullString, CaptionName) '上記で取得したキャプションを元にウィンドウを探す
 
Loop While myHwnd = 0

Do
  myHwnd = FindWindow(vbNullString, CaptionName) '上記で取得したキャプションを元にウィンドウを探す
  DoEvents
Loop While myHwnd = 0
 
-----------------------------------------------------------
 
ざっくり見た限りではこの辺りなのではないかと。

投稿日時: 21/10/29 08:58:59
投稿者: Alice

sk様
 
早速のアドバイスありがとうございます。
 
「sk様の方法で解決できそう!」と思ったのですが、状況は変わらずでした。
(タスクバーで点滅され、アクティブにならず、それ以降の処理が流れていってしまいます。)
 
試しに、DoEventsを下記の前に入れて見ましたが同様です。
 
・myHwnd = FindWindow(vbNullString, CaptionName)の前
・SetForegroundWindowの前
 

引用:
Do
  myHwnd = FindWindow(vbNullString, CaptionName) '上記で取得したキャプションを元にウィンドウを探す
  DoEvents
Loop While myHwnd = 0

 
引き続き解決方法がありそうでしたら、アドバイスをいただけると幸いです。

投稿日時: 21/10/29 10:45:40
投稿者: Alice

引き続き解決方法をwebで探していたところ、下記サイトの情報を元に外部アプリケーションを一旦最小化した後、再度元のサイズに戻したところアクティブにすることができした。
(DoEventsを外しても、外部アプリケーションをアクティブにできた。)
 
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q12235902107
 
※ 合間にいれたSleepは念の為、処理が追い付かない場合を鑑みて入れています
 

'CubePDFウィンドウが開いたか確認
Do
  myHwnd = FindWindow(vbNullString, CaptionName) '上記で取得したキャプションを元にウィンドウを探す
                                                                                          
Loop While myHwnd = 0
                    
    chk = ShowWindow(myHwnd, 2) '一旦、「CubePDF」最小化

       Sleep 1000                    
    chk = ShowWindow(myHwnd, 1) '「CubePDF」元のサイズに戻す
                        
      Sleep 1000

    With CreateObject("Wscript.Shell")  'マクロだとCubePDF上で保存先パスがペーストされずデフォルトのままなので、指定パスへ移動させる
         .SendKeys "{TAB}"
         .SendKeys "{TAB}"
         .SendKeys "{TAB}"
         .SendKeys "{TAB}"
         .SendKeys "{TAB}"
         .SendKeys "{ENTER}"
    End With

------------------------
解決はできましたが全般的にSetForegroundWindowは、できたりできなかったりがある関数であれば、今後は使わないようにしようと考えていますが、皆さまどうでしょうか?
(SetForegroundWindowの使用感を、いくつか聞きたいと思うのでしばらくこのトピックをクローズにしないでおきます。数日後、「解決済み」でクローズします。)
 
 

回答
投稿日時: 21/10/29 20:29:16
投稿者: kumatti
投稿者のウェブサイトに移動

『入力キューのアタッチ・デタッチ』と言う今ではほとんど馴染みのないテクニックが必要になります。
http://web.archive.org/web/20031016221727/http:/www2.moug.net/app/bbs/message.php?cat=acm_v&id=20030926-000040

投稿日時: 21/11/01 16:34:00
投稿者: Alice

kumatti様
 
書込みありがとうございます。
 
>今ではほとんど馴染みのないテクニック
 
→そうなんですか。。。
とりあえず、今回の自分の経験をふまえて今後は「SetForegroundWindow」より、「ShowWindow」でアクティブに
しようと考えています。
(自分のPCだけでなく、他のPCでもこのマクロを使用するので、多少余計な動きでも安定動作する方が好ましいので。)