Visual Basic 中学校 掲示板 投稿の管理
タグのない投稿を抽出
統計
RSS
Visual Basic 中学校
投稿一覧
【UIAutomation】UIツリー構造の揺れについて
この投稿へのリンク
https://keijiban.umayadia.com/ThreadDetail.aspx?ThreadId=30832#CommentId85582
この投稿の削除
削除パスワード
削除する
コメント本文
投稿者
kake
 (社会人)
投稿日時
2023/1/10 02:46:26
初めて投稿いたします。
当方、現在Excel VBAでUIAutomationを勉強中の者です。
現在勉強として、エクセルA列に複数行記載されている英文を1行ずつコピーして、Edgeで開いたDeepL(Web翻訳サイト)に貼り付け、出力された訳文をエクセルB列に順次転記していく、
というスクリプトを作成しております。
ひとまず開発用メインPCでの実装と動作検証はうまくいったのですが、OSが違うサブPCで検証するとうまく動作しなかったため確認したところ、Inspect上のUIツリー構造がメインPCとサブPCで1段ズレていることが分かりました。(サブPCの方が1段多くなってる)
メイン/サブPCのOSはそれぞれWin11, Win10で、Edgeのバージョンはどちらも最新です。
この場合、OSごとにコードを書き分けるしか対処法は無いでしょうか?
またUIAutomationを使用したスクリプトは一般的に、こういったOSやバージョンの変化に弱いものなののでしょうか?
恐れ入りますが、ご教示をいただけますと大変幸いです。
【メインPC OS: Win11】
⊟"" メイン
┣⊟"毎日、何百万もの人々がDeeplで翻訳・・・"
┗⊟"" グループ
┗⊟"" タブパネル
┣⊞"テキストの翻訳" 見出し
┣⊟"" グループ
┃ ┣⊟"原文" 地域
┣⊞"原文" 見出し
┣⊞"" グループ
┣⊞"" グループ
┗⊟"" グループ
┣⊞"" グループ
┣⊟"" グループ
┃ ┗⊡"原文" 編集 (←ここのValueに原文の文字列が入ってる)
【サブPC OS: Win10】
⊟"" メイン
┣⊟"毎日、何百万もの人々がDeeplで翻訳・・・"
┗⊟"" グループ
┗⊟"" タブパネル
┣⊞"テキストの翻訳" 見出し
┣⊟"" グループ
┃ ┣⊟"原文" 地域
┣⊞"原文" 見出し
┣⊞"" グループ
┣⊞"" グループ
┗⊟"" グループ
┣⊞"" グループ
┣⊟"" グループ
┃ ┗⊟"原文" グループ
┗⊡"原文" 編集 (←ここのValueに原文の文字列が入ってる)
以下はメインPCで動作確認できているコードになります。
補助コメントが多いので見づらく申し訳ございませんが、併せてご確認いただけますと幸いです。
Option Explicit
'参考:https://yaromai.jp/vba-uiautomation/
Sub kido_deepl()
CreateObject("WScript.Shell").Run "msedge.exe -url " & "https://www.deepl.com/translator"
End Sub
Sub honyaku_deepl()
'前の処理で残ってる訳文をクリア ※1行目は見出し、2行目から原文(A列)・訳文(B列)
Range(Cells(2, 2), Cells(Rows.Count, 2)).ClearContents
'UIAutomationに使う各種オブジェクトを宣言
Dim uiAuto As CUIAutomation '検索/クリック/入出力等の各種操作を行うための大元のオブジェクト
Dim uiCnd As IUIAutomationCondition '要素の検索条件を設定するためのオブジェクト
Dim uiElm As IUIAutomationElement '要素を検索するためのオブジェクト
Dim uiElm_root As IUIAutomationElement '要素を検索するためのオブジェクト -> root(デスクトップ)取得専用
Dim uiElm_deepl As IUIAutomationElement '要素を検索するためのオブジェクト -> DeepL取得専用
Dim uiInv As IUIAutomationInvokePattern '要素をクリックするためのオブジェクト
Dim uiVal As IUIAutomationValuePattern '要素に値を入力したり、要素から値を出力するためのオブジェクト
'通常の変数宣言
Dim i As Long, inputText As String, transText As String, prevText As String
'デスクトップ要素を取得
Set uiAuto = New CUIAutomation
Set uiElm_root = uiAuto.GetRootElement()
'DeepL(メイン)要素を取得 (デスクトップから直接の原文/訳文の要素を検索してもいけるが、検索負荷を減らす目的でDeepL画面を経由してる)
Set uiCnd = uiAuto.CreatePropertyCondition(UIA_AutomationIdPropertyId, "dl_translator")
Set uiElm_deepl = uiElm_root.FindFirst(TreeScope_Descendants, uiCnd)
'処理を個数分ループ
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
' ▼▼ 原文入力 ▼▼
'"原文"欄の要素を取得
Set uiCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "lmt__textarea lmt__source_textarea lmt__textarea_base_style")
Set uiElm = uiElm_deepl.FindFirst(TreeScope_Descendants, uiCnd)
'"原文"欄に文字列を入力
Set uiVal = uiElm.GetCurrentPattern(UIA_ValuePatternId)
If i = 2 Then
uiVal.SetValue "" '初回のみブランク入力(前に処理したときの訳文が残ってると狂うので)
Application.Wait Now() + TimeValue("00:00:01") 'ブランクの原文→訳文反映までちょっと待機 Do Loopで訳文=""を判定した方が確実かも
End If
uiVal.SetValue Cells(i, 1).Value 'Excel A列→DeepLに原文入力
' ▲▲▲▲▲▲▲▲▲
' ▼▼ 訳文出力 ▼▼
'"訳文"欄の要素を取得
Set uiCnd = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "lmt__textarea lmt__target_textarea lmt__textarea_base_style") 'dl_disableがついてエラーになるときがあるので注意 "lmt__textarea lmt__target_textarea lmt__textarea_base_style dl_disabled"
Do '処理速くてSetミスる時があるので、できるまでループ
Set uiElm = uiElm_deepl.FindFirst(TreeScope_Descendants, uiCnd)
Loop While uiElm Is Nothing
Do '新しい翻訳結果を取得できるまでループ
Set uiVal = uiElm.GetCurrentPattern(UIA_ValuePatternId)
transText = uiVal.CurrentValue 'CurrentValueで今選択してる要素(ここでは訳文欄)の文字列を取得できる
Loop While prevText = transText
Cells(i, 2) = transText 'B列に訳文を出力
prevText = transText
' ▲▲▲▲▲▲▲▲▲
Next i
End Sub