【VBA】「エクセル栄養君」の食品の一覧をすべてクリックするマクロを紹介します!

その他栄養計算ソフトについて
この記事は約10分で読めます。

みなさん,こんにちは.
シンノユウキ(shinno1993)です.

今回はVBAを使った,「エクセル栄養君」の食品の一覧のボタンをすべてクリックするマクロを紹介します.活用の機会は少ないかも?ですが,こんなことも可能!という目線でごらんください.

ではいきましょう!

 

こんな感じになります!

最初に,どんな感じになるのかを紹介します.マクロを実行すると,以下のようになります:

Excelシートやユーザーフォームへの反映が遅れていますが,すべてしっかりとクリックしています.

ではコードを紹介していきましょう!

 

コード全文はこちら!

コードは以下のようになります:

 

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function SetCursorPos Lib "User32" (ByVal x As Long, ByVal y As Long) As Long
Private Type Position
    x As Long
    y As Long
End Type
Declare Function GetCursorPos Lib "User32" _
    (lpPoint As Position) As Long
Declare Sub mouse_event Lib "User32" ( _
    ByVal dwFlags As Long, _
    Optional ByVal dx As Long = 0, _
    Optional ByVal dy As Long = 0, _
    Optional ByVal dwDate As Long = 0, _
    Optional ByVal dwExtraInfo As Long = 0)

Sub test()
    Dim itemCount As Long
    Dim listCount As Long
    Dim cnt As Long
    Dim item As Long
    Dim ctg As Long
    Dim loopCount As Long
    Dim mode As Long
    Dim foodAddBtn As Position
    Dim ctgBtn As Position
    Dim food As Position
    Dim leftFoodFirst As Position
    Dim rightFoodFirst As Position
    Dim rightDown1 As Position
    Dim rightDown2 As Position
    Dim leftDown1 As Position
    Dim leftDown2 As Position
    Dim aryCtgInfo As Variant
    Dim window As String
    
   
    '---設定---
    foodAddBtn.x = 214: foodAddBtn.y = 72
    leftFoodFirst.x = 810: leftFoodFirst.y = 341
    rightFoodFirst.x = 1088: rightFoodFirst.y = 341
    leftDown1.x = 951: leftDown1.y = 642
    leftDown2.x = 951: leftDown2.y = 657
    rightDown1.x = 1222: rightDown1.y = 642
    rightDown2.x = 1222: rightDown2.y = 657
    Const ITEM_OFFSET = 15
    Const CTG_START = 1
    Const CTG_END = 18
    aryCtgInfo = SettingSh.Range("A2:E19")
    Const ITEM_COUNT_INDEX = 2
    Const LIST_COUNT_INDEX = 3
    Const X_INDEX = 4
    Const Y_INDEX = 5
    '----------
    
    Application.ScreenUpdating = True
    ThisWorkbook.ActiveSheet.Range("B4").Activate
    'Call click(foodAddBtn)
    
    For ctg = CTG_START To CTG_END
        'カテゴリのラジオボタンをクリック
        ctgBtn.x = aryCtgInfo(ctg, X_INDEX): ctgBtn.y = aryCtgInfo(ctg, Y_INDEX)
        Call click(ctgBtn)
        itemCount = aryCtgInfo(ctg, ITEM_COUNT_INDEX)
        listCount = aryCtgInfo(ctg, LIST_COUNT_INDEX)
        loopCount = getLoopCount(itemCount, listCount)
        
        'リストボックス内のすべてのアイテムをループ
        For cnt = 1 To loopCount
            window = getWindow(ctg)
            If window = "Left" Then
                food = leftFoodFirst
            Else
                food = rightFoodFirst
            End If
            
            'リストボックスに表示されているすべてのアイテムをクリック
            For item = 1 To listCount
                Call click(food)
                food.y = food.y + ITEM_OFFSET
            Next item
            
            'リストに表示されているアイテムの数で↓ボタンの場所が違うため
            window = getWindow(ctg)
            If listCount = 20 Then
                If window = "Left" Then
                    Call click(leftDown1, listCount)
                Else
                    Call click(rightDown1, listCount)
                End If
            Else
                If window = "Left" Then
                    Call click(leftDown2, listCount)
                Else
                    Call click(rightDown2, listCount)
                End If
            End If
        Next cnt
        
        'リストボックスの最後のあまりをクリック
        mode = getMode(itemCount, listCount)
        If mode <> 0 Then
            If window = "Left" Then
                food = leftFoodFirst
            Else
                food = rightFoodFirst
            End If
            food.y = food.y + (listCount - mode) * ITEM_OFFSET
            For item = listCount - mode To listCount
                Call click(food)
                food.y = food.y + ITEM_OFFSET
            Next item
        End If
    Next ctg
End Sub

Sub click(pos As Position, Optional clicks = 1)
    Dim click As Long
    SetCursorPos pos.x, pos.y
    For click = 1 To clicks
        mouse_event 2
        mouse_event 4
    Next
End Sub

Sub 座標を調べる()
    Dim pos As Position
    Call GetCursorPos(pos)
    Debug.Print pos.x, pos.y
End Sub

Function getMode(itemCount, listCount)
    getMode = itemCount Mod (listCount)
End Function

Function getLoopCount(itemCount, listCount)
    getLoopCount = WorksheetFunction.RoundDown(itemCount / listCount, 0)
End Function

Function getWindow(ctg)
    Dim food As Position
    If ctg < 10 Then
        getWindow = "Left"
    Else
        getWindow = "Right"
    End If
End Function

 

こちらのコードは,以下のサイトを参考にしました.

 

これらのコードは,スクリーン上の座標を指定してクリックしています.私のディスプレイ環境は1920×1080の等倍環境ですので,これと同じ環境であれば,上記のコードで問題ありません.

しかし,それ以外の環境の場合は,クリックするボタンの座標をそれぞれ修正してください.

また,食品群のラジオボタンの座標や情報はコード上に記述すると複雑になるため,以下のような形でシート上に記述しています.これをシートのA1からコピーし,シートのオブジェクト名を「SettingSh」とすれば問題ありません.

itmlstxy
116420698340
26221698365
32721698395
49421698416
55220698446
638520698475
718120698496
85220698526
95420698551
1044620987339
1129320987363
122020987391
135820987416
143120987442
1514220987474
165921987496
1713621987522
182320987552

 

まとめ

今回はVBAを利用して「エクセル栄養君」の自動化に挑戦してみました.次回は料理一覧を自動で入力できるマクロを作成してみます.

タイトルとURLをコピーしました