【VBA】セレクトボックス操作（InternetExplorer）

2021年9月5日

セレクトボックス

最近、美容を気遣ってる童顔Jimです。ども✋

今回はセレクトボックスの記事です。

理由は前回の通りですね。。。。

んじゃ、先ずは・・・

↓セレクトボックス（メニュー）

崖っぷち派遣社員

↓HTML

Excelでいうドロップダウン（プルダウン）とかユーザーフォームでいうコンボボックスみたいなもんっす。

 

コードを書き散らす

単純にセレクトボックスの文言を変更するだけです。

参照設定要っす。

Option Explicit
Sub selectbox()
Const gakeUrl = "https://bw-rocket.com/2021/09/03/post-2786/"
Dim objIe As InternetExplorer
    If GetWindow(objIe) = False Then
        Set objIe = CreateObject("InternetExplorer.Application")
        objIe.Visible = True
        objIe.navigate gakeUrl
        Call WaitLoad(objIe)
    End If
    '空白から『崖っぷち』に変更
    If ChangeSelect(objIe, "gakeid", "崖っぷち") = True Then
        MsgBox "更新ボタンを押すコード挿入", vbOKOnly, "変更完了"
    End If
    '空白から『派遣社員』に変更
    If ChangeSelect(objIe, "gakeid", "派遣社員") = True Then
        MsgBox "更新ボタンを押すコード挿入", vbOKOnly, "変更完了"
    End If
End Sub
Function ChangeSelect(ByVal objIe As Object, myId As String, targetStr As String)
Dim ieDocument As HTMLDocument
Dim i As Integer
    Set ieDocument = objIe.document.getElementById(myId)
    For i = 0 To ieDocument.Options.Length
        If ieDocument.Options(i).Text = targetStr Then
            ieDocument.selectedIndex = i
            ChangeSelect = True
            Exit For
        End If
    Next
End Function
Private Sub WaitLoad(ByVal objIe As InternetExplorer)
    Do While objIe.Busy = True Or objIe.readyState <> 4
        DoEvents
    Loop
End Sub
Function GetWindow(ByRef objIe As InternetExplorer)
Const gakeTitle = "【VBA】セレクトボックス操作（InternetExplorer） | 崖っぷち派遣社員の日常"
Dim shellObject As Object
Dim windowObject As Object
    Set shellObject = CreateObject("Shell.Application")
    For Each windowObject In shellObject.Windows
        If windowObject = "Internet Explorer" Then
            If windowObject.document.Title = gakeTitle Then
                Set objIe = windowObject
                GetWindow = True
                Exit For
            End If
        End If
    Next
End Function

 

そゆ感じ。ではまた✋