その他

VBA：作業前後のwindowHandleを調べる[No72]

スポンサーリンク

動作準備

今回は、以前の記事で扱ったエクセル、プログラムを利用することを前提とした「作業前後のウィンドウハンドルを調べる方法」を紹介します。

まだ前回の記事を読まれていない方は、是非下記リンクから一読して頂けると嬉しいです。

no image
VBA：ハンドル情報（hwnd）配列取得・一覧出力[No70]
VBAでウィンドウハンドル（Window Handle、HWND）を操作するには、次の情報が１つ以上必要です。 ハンドル番号（HAND ID、Handle ID、hwnd ID、Hw ...

事前に準備するものとしては、４つのシートが必要になります。

excelを作成し、「TARGET01」、「TARGET02」、「MATCHED」、「MIS_MATCHED」のシートを用意しておきます。

プログラム

具体的なプログラムについては下記のコードでご確認下さい。


Option Explicit

'注意シートに何もないと変数がオーバーフローします。

Const SHEET_TARGET01    As String = "TARGET01"
Const SHEET_TARGET02    As String = "TARGET02"
Const SHEET_MATCHED     As String = "MATCHED"
Const SHEET_MISMATCHED  As String = "MIS_MATCHED"

Public Sub CompareBeforeAndAfterHandle()
    Dim arrayBefore01() As String
    Dim arrayBefore02() As String
    Dim arrayBefore03() As String
    Dim arrayBefore04() As String

    Dim arrayAfter01() As String
    Dim arrayAfter02() As String
    Dim arrayAfter03() As String
    Dim arrayAfter04() As String
    
    Call InitSHEET(SHEET_MATCHED)
    Call InitSHEET(SHEET_MISMATCHED)
    
    Call PutIntoAnArray(SHEET_TARGET01, arrayBefore01, arrayBefore02, arrayBefore03, arrayBefore04)
    Call PutIntoAnArray(SHEET_TARGET02, arrayAfter01, arrayAfter02, arrayAfter03, arrayAfter04)
        
    If UBound(arrayBefore01) >= UBound(arrayAfter01) Then
        Call Comparison(SHEET_TARGET01, arrayBefore01, arrayBefore02, arrayBefore03, arrayBefore04, _
                        SHEET_TARGET02, arrayAfter01, arrayAfter02, arrayAfter03, arrayAfter04)
    Else
        Call Comparison(SHEET_TARGET02, arrayAfter01, arrayAfter02, arrayAfter03, arrayAfter04, _
                        SHEET_TARGET01, arrayBefore01, arrayBefore02, arrayBefore03, arrayBefore04)
    End If
    
    Call SelectSheetRangeA1(SHEET_TARGET01)
    Call SelectSheetRangeA1(SHEET_TARGET02)
    Call SelectSheetRangeA1(SHEET_MATCHED)
    Call SelectSheetRangeA1(SHEET_MISMATCHED)
End Sub

スポンサーリンク


Private Sub Comparison(ByVal SheetNameA As String, ByRef a01() As String, ByRef a02() As String, ByRef a03() As String, ByRef a04() As String, _
                       ByVal SheetNameB As String, ByRef b01() As String, ByRef b02() As String, ByRef b03() As String, ByRef b04() As String)
    Dim matchCounter As Integer
    matchCounter = 2
    
    Dim notMatchCounter As Integer
    notMatchCounter = 2
    
    Dim a As Long
    Dim b As Long
    
    Dim nothingFlg As Boolean
    For a = 0 To UBound(a01)
        For b = 0 To UBound(b01)
            nothingFlg = False
            
            If (StrComp(a01(a), b01(b), vbTextCompare) = 0 And _
                StrComp(a02(a), b02(b), vbTextCompare) = 0 And _
                StrComp(a03(a), b03(b), vbTextCompare) = 0 And _
                StrComp(a04(a), b04(b), vbTextCompare) = 0) Then
                
                Call WriteToCell(SHEET_MATCHED, a, matchCounter, SheetNameA, a01, a02, a03, a04)
                matchCounter = matchCounter + 1
                nothingFlg = True
                Exit For
            End If
        Next b
        
        If nothingFlg = False Then
            Call WriteToCell(SHEET_MISMATCHED, a, notMatchCounter, SheetNameA, a01, a02, a03, a04)
            notMatchCounter = notMatchCounter + 1
        End If
    Next a
End Sub

Private Sub InitSHEET(ByVal sheetName As String)
    With Worksheets(sheetName)
        .Select
        .Cells.Clear
        
        .Cells(1, 1) = "シート名"
        .Cells(1, 2) = "HAND種類"
        .Cells(1, 3) = "HANDID"
        .Cells(1, 4) = "captionName"
        .Cells(1, 5) = "className"
         
        .Range(.Cells(1, 1), .Cells(1, 5)).Font.Color = RGB(0, 0, 0)
        .Range(.Cells(1, 1), .Cells(1, 5)).Interior.Color = RGB(169, 208, 142)
         
        .Range(.Cells(1, 1), .Cells(1, 5)).Borders.LineStyle = True
        .Range(.Cells(1, 1), .Cells(1, 5)).BorderAround Weight:=xlMedium
    End With
End Sub

Private Sub PutIntoAnArray(ByVal sheetName As String, _
        ByRef array01() As String, _
        ByRef array02() As String, _
        ByRef array03() As String, _
        ByRef array04() As String)

    With Worksheets(sheetName)
        .Select
        
        Dim maxRow As Long
        maxRow = .Cells(1, 1).End(xlDown).Row
        
        Dim counter As Integer
        counter = 0
        Dim i As Long
        For i = 2 To maxRow
            ReDim Preserve array01(counter)
            ReDim Preserve array02(counter)
            ReDim Preserve array03(counter)
            ReDim Preserve array04(counter)
            
            array01(counter) = .Cells(i, 1).Value
            array02(counter) = .Cells(i, 2).Value
            array03(counter) = .Cells(i, 3).Value
            array04(counter) = .Cells(i, 4).Value
            
            counter = counter + 1
        Next
    End With
End Sub

スポンサーリンク


Private Sub WriteToCell(ByVal targetSheetName As String, _
        ByVal i As Integer, _
        ByVal counter As Integer, _
        ByVal sheetName As String, _
        ByRef arrayTemp01() As String, _
        ByRef arrayTemp02() As String, _
        ByRef arrayTemp03() As String, _
        ByRef arrayTemp04() As String)

    With Worksheets(targetSheetName)
        .Select
        .Cells(counter, 1) = sheetName
        .Cells(counter, 2) = arrayTemp01(i)
        .Cells(counter, 3) = arrayTemp02(i)
        .Cells(counter, 4) = arrayTemp03(i)
        .Cells(counter, 5) = arrayTemp04(i)
    End With
End Sub

Private Sub SelectSheetRangeA1(ByVal sheetName As String)
    Sheets(sheetName).Activate
    ActiveWindow.Zoom = 70
    Range("A1").Select
End Sub

実行イメージ

下記リンク先の記事で紹介した「ハンドル情報の出力」を実行し、「HWND」をシートに出力したものを、「TARGET01」のシートにコピーします。

no image
VBA：ハンドル情報（hwnd）配列取得・一覧出力[No70]
VBAでウィンドウハンドル（Window Handle、HWND）を操作するには、次の情報が１つ以上必要です。 ハンドル番号（HAND ID、Handle ID、hwnd ID、Hw ...

何らかの作業をした後に、再度「ハンドル情報の出力」を実行し、出力されたHWNDの内容を今度は「TARGET02」のシートにコピーします。

その後、この記事の「CompareBeforeAndAfterHandle」を実行すると、「TARGET01」、「TARGET02」で一致したものは「MATCHED」シートに出力され、不一致となったものは「MIS_MATCHED」シートに出力されます。

なお、今回は「TARGET01」と「TARGET02」の内容は意図的に不一致となるようにしています。

「TARGET01」、「TARGET02」、「MATCHED」、「MIS_MATCHED」の４つのシートの様子については、下に画像でまとめているのでご確認下さい。

関連記事

no image
ウィンドウハンドル関連の記事一覧[No74]
記事一覧 ハンドル番号、キャプション名、クラス名について書かれた記事のまとめです。 最後までお付き合いいただきありがとうございます！ この情報が誰かの役にたてれば幸 ...

雑記

今日10月21日の夜から明日の明け方にかけて、オリオン座流星群が見頃だそうです。

オリオン座流星群は、今年に限らず毎年10月21日頃に活動のピークを迎える流星群なので、この頃になると楽しみにしてる方も多いのではないでしょうか。

オリオン座流星群はスピードが速いことが大きな特徴として知られています。スピードが速い流星群は、それだけエネルギーも大きいということなので、比較的明るくて見やすく感じられ、天候などの条件が良ければ、１時間という短い時間に１５個から２０個もの流れ星を見ることができます。

また、この時期はオリオン座流星群の周りを囲むようにして、ベテルギウスやシリウスなど、冬に見頃を迎える様々な星座の一等星もたくさん輝いています。

流れ星を待っている間に、キラキラと輝く多くの星を楽しみながら過ごすのもおすすめです。まだ10月とは言え、夜間はすっかり寒い季節となりましたので、防寒対策をしっかりして天体観測を楽しみましょう。

最後までお付き合いいただきありがとうございます！

この情報が誰かの役にたてれば幸いです。

スポンサーリンク

-その他