見出し画像

【ExcelVBA】IE自動入力マクロ作ったよ

あおこ

はじめに

下記のマガジンでちょこちょこ進めているアプリ（ツール？）なんですが
IEで動くやつがいいなーなどと言われっちまったので
IE版を作ってみました。

背景

項目数がめちゃくちゃ多いフォームのテスト時に
テストデータ入力が自動でできたらいいのにと思ったからです。

開発環境

・Excel2016
・IE11

IEを操作するのでVBscriptかVBAかPowerShellがやりやすいかと
思うんですが（直でIEを呼べる）
設定ファイルが欲しかったのでExcelVBAにしました。

仕様

IEの画面に値を自動で入力します。

IEでまず入力したいURLを開いて…
（画像ではローカルのHTMLを使用してますがweb上のURLでも使用できます）

無題

URLを入力して「ID取得」ボタンを押すと画面のIDを取得できます

無題

こんな感じ！😀

無題

設定値欄を埋めてから「入力値設定」ボタンを押します

無題

設定されました！😗

無題

ちなみに入力が面倒な時のためにデフォルト値設定も入れました
チェックボックスをONにしてから「ID取得」ボタンを押すと
設定値が自動設定されます。

無題

ソースコード

ソースの説明とか全然してないけどこんな感じです！←
クラスモジュール使ったりして部品化してみましたが
いまいち奇麗じゃないかも…

クラスモジュールがわからんって方は標準モジュールでも大丈夫です。

今更だけどデフォルト値ベタ打ちじゃなくてセルから取ってきた方が
いいかもね💦

①参照設定
　Excelの参照設定で以下をONにしてください
　・Microsoft HTML Object Library
　・Microsoft Internet Controls

無題

②メインモジュール（標準モジュールに設定）

Option Explicit

Const COL_ID As String = "B"
Const COL_VAL As String = "C"
Const ROW_START As Long = 5
Const END_MSG As String = "完了しました"
Const ERR_MSG As String = "ページが見つかりませんでした"

'ID取得イベント
Public Sub getID_Click()

   Dim clsie As New clsie

   'urlが開かれているかチェック
   If clsie.getWindow = False Then
       MsgBox ERR_MSG, vbCritical
       Set clsie = Nothing
       Exit Sub
   End If
   
   Application.ScreenUpdating = False

   '範囲設定
   Dim clsarea As New clsarea
   Set clsarea.sheet = ThisWorkbook.Worksheets("config")
   clsarea.startRow = ROW_START
   clsarea.getLastRow (COL_ID)
   clsarea.startCol = COL_ID
   clsarea.endCol = COL_VAL
   
   'セルのクリア
   clsarea.clearCells

   Dim ipt As Object
   Dim i As Long
   Dim defaultFlg As Long
   defaultFlg = clsarea.sheet.CheckBoxes("chkDefault").Value
   i = clsarea.startRow
   For Each ipt In clsie.objIE.document.getElementsByTagName("input")
   
       Select Case ipt.Type
       
           Case "text"
               clsarea.sheet.Cells(i, COL_ID).Value = ipt.ID
               If defaultFlg = xlOn Then
                  clsarea.sheet.Cells(i, COL_VAL).Value = "あ"
               End If
               i = i + 1
           Case "checkbox", "radio"
               clsarea.sheet.Cells(i, COL_ID).Value = ipt.ID
               'true/falseの入力規則を入れる
               With Range(Cells(i, COL_VAL), Cells(i, COL_VAL)).Validation
                   .Delete
                   .Add Type:=xlValidateList, _
                    Operator:=xlEqual, _
                   Formula1:="true,false"
               End With
               If defaultFlg = xlOn Then
                  clsarea.sheet.Cells(i, COL_VAL).Value = "true"
               End If
               i = i + 1
       End Select
       
   Next
   
   For Each ipt In clsie.objIE.document.getElementsByTagName("select")
       clsarea.sheet.Cells(i, COL_ID).Value = ipt.ID
       'optionの値で入力規則を設定する
       Dim val As String
       Dim op As Object
       For Each op In ipt.Options
           val = val + op.Value + ","
       Next
       Set op = Nothing
       val = Left(val, Len(val) - 1)
       
       With Range(Cells(i, COL_VAL), Cells(i, COL_VAL)).Validation
           .Delete
           .Add Type:=xlValidateList, _
           Operator:=xlEqual, _
           Formula1:=val
       End With
       If defaultFlg = xlOn Then
           clsarea.sheet.Cells(i, COL_VAL).Value = ipt.Options(0).Value
       End If
       
       i = i + 1
   Next

   For Each ipt In clsie.objIE.document.getElementsByTagName("textarea")
       If defaultFlg = xlOn Then
           clsarea.sheet.Cells(i, COL_VAL).Value = "あ"
       End If
       clsarea.sheet.Cells(i, COL_ID).Value = ipt.ID
       i = i + 1
   Next
   
   '書式を設定する
   clsarea.getLastRow (COL_ID)
   clsarea.setFormat
   
   Set ipt = Nothing
   Set clsie = Nothing
   Set clsarea = Nothing
   
   Application.ScreenUpdating = True
   
   MsgBox END_MSG, vbInformation
   
End Sub

'入力値設定イベント
Public Sub setValue_Click()

   Dim clsie As New clsie
   
   'urlが開かれているかチェック
   If clsie.getWindow = False Then
       MsgBox ERR_MSG, vbCritical
       Set clsie = Nothing
       Exit Sub
   End If
   
   Dim clsarea As New clsarea

   Set clsarea.sheet = ThisWorkbook.Worksheets("config")
   clsarea.startRow = ROW_START
   clsarea.getLastRow (COL_ID)
   
   Dim j As Long
   
   For j = clsarea.startRow To clsarea.endRow
       
       Dim ipt As Object
       Dim i As Long
       i = clsarea.startRow
       For Each ipt In clsie.objIE.document.getElementsByTagName("input")
           If (ipt.ID <> "") And (ipt.ID = clsarea.sheet.Cells(j, COL_ID).Value) _
               And (clsarea.sheet.Cells(j, COL_VAL).Value <> "") Then
               Select Case ipt.Type
                   Case "text"
                       ipt.Value = clsarea.sheet.Cells(j, COL_VAL).Value
                   Case "checkbox", "radio"
                       ipt.Checked = clsarea.sheet.Cells(j, COL_VAL).Value
               End Select
           End If
       Next
   
       For Each ipt In clsie.objIE.document.getElementsByTagName("select")
           If (ipt.ID <> "") And (ipt.ID = clsarea.sheet.Cells(j, COL_ID).Value) _
               And (clsarea.sheet.Cells(j, COL_VAL).Value <> "") Then
               ipt.Value = clsarea.sheet.Cells(j, COL_VAL).Value
           End If
       Next

       For Each ipt In clsie.objIE.document.getElementsByTagName("textarea")
           If (ipt.ID <> "") And (ipt.ID = clsarea.sheet.Cells(j, COL_ID).Value) _
               And (clsarea.sheet.Cells(j, COL_VAL).Value <> "") Then
               ipt.Value = clsarea.sheet.Cells(j, COL_VAL).Value
           End If
       Next
   
   Next j
   
   Set ipt = Nothing
   Set clsie = Nothing
   Set clsarea = Nothing
   
End Sub

③セル編集クラス（クラスモジュールに設定）　
　※クラス名はclsAreaにしています

Option Explicit

Public sheet As Worksheet
Public startRow As Long
Public endRow As Long
Public startCol As String
Public endCol As String

Private Sub Class_Initialize()
   Set sheet = ThisWorkbook.Worksheets(1)
   startRow = 1
   endRow = 1
   startCol = "A"
   endCol = "A"
End Sub

'最終行の取得
Public Sub getLastRow(col As String)

   Dim lastRow As Long
   lastRow = sheet.Cells(Rows.Count, col).End(xlUp).row
   
   If lastRow < startRow Then
       endRow = startRow
   Else
       endRow = lastRow
   End If

End Sub

'書式クリア
Public Sub clearCells()

   Range(sheet.Cells(startRow, startCol), sheet.Cells(endRow, endCol)).clear

End Sub

'書式設定
Public Sub setFormat()

   '罫線を引く
   With Range(sheet.Cells(startRow, startCol), sheet.Cells(endRow, endCol)).Borders
   
       .LineStyle = xlContinuous
       .Weight = xlThin
       .ColorIndex = 0
   
   End With

End Sub

④IE操作クラス（クラスモジュールに設定）
　※クラス名はclsIEにしています

Option Explicit

Public url As String

Public objIE As New InternetExplorer

Private Sub Class_Initialize()

   url = ThisWorkbook.Worksheets("config").Range("C2").Value

End Sub
'全てのウィンドウから対象のIE、URLを検索
Public Function getWindow() As Boolean

   Dim shl As Object
   Set shl = CreateObject("Shell.Application")
   
   Dim win As Object
  
   For Each win In shl.Windows
       
       If TypeName(win.document) = "HTMLDocument" Then
       
           If win.LocationURL = url Then
               Set objIE = win
               getWindow = True
               Exit For
           End If
           
       End If
   
   Next
   
   Set shl = Nothing
   
End Function

最後に

現場運用もしてないのでこれから改良の余地ありですが
何かのヒントになればと思います。

しかしVBAでIE操作久々に使ったけど
今スクレイピングとかで結構流行ってる？んですね
個人的には表計算ソフトの枠を超えたことはやりたくないんだけど😅


いいなと思ったら応援しよう！