スクリプト置き場

' テスト用コード
item = SelectList(Array("item1", "item2", "item3", "item4", "item5"), TYPE_STRING, "選択してください")
MsgBox item
WScript.Quit

'###########################################################
'            ドロップダウンリストで項目を選択
' 関数名
'    SelectList
'
' 引数
'    ItemList：配列形式のVariant型
'              ドロップダウンリストに設定する項目を指定
'    Type    ：戻り値の型
'              TYPE_INDEX → 数値型のインデックス(0-origine)で返す
'                            キャンセル時は-1を返す
'              TYPE_STRING → 選択された項目の文字列を返す
'                             キャンセル時は"Cancel"を返す
'    Caption ：ダイアログに表示させる文字
'
' 戻り値
'    第2引数Typeに応じて変化
'    詳細は引数の説明を参照
'
' 制限事項
'    IE右上の×ボタンから画面を閉じた場合、エラーが発生
'

Dim RetVal
Dim ObjListIE
Const TYPE_INDEX    = 0
Const TYPE_STRING   = 1
Const STRING_CANCEL = "Cancel"
Const SELECT_WIDTH  = "300px"     ' (IE_WIDTH-50)程度
Const SELECT_MARGINBOTTOM = "10px"
Const IE_HEIGHT     = 150
Const IE_WIDTH      = 350
Const IE_LEFT       = 300
Const IE_TOP        = 300

Function SelectList(ItemList, RetType, Caption)

Dim ObjSelect, ObjLF, ObjButton1, ObjButton2, ObjOption, item
    
    ' キャンセル時の戻り値を設定
    RetVal = STRING_CANCEL
    
    ' IEオブジェクトを取得
    Set ObjListIE = WScript.CreateObject("InternetExplorer.Application")
    ObjListIE.Navigate "about:blank"
    
    ' 起動終了まで待機
    Do While(ObjListIE.Busy)
        WScript.Sleep 50
    Loop

' IEオブジェクトにテキストを追加
    ObjListIE.Document.Body.insertAdjacentText "afterBegin", Caption
    
    ' SELECTタグを作成
    Set ObjSelect = ObjListIE.Document.createElement ("select")
    ObjSelect.style.width = SELECT_WIDTH
    ObjSelect.style.marginBottom = SELECT_MARGINBOTTOM
    ObjListIE.Document.Body.insertBefore(ObjSelect)
    
    ' SELECTタグにOPTIONを追加
    index = 0
    For Each item In ItemList
        Set ObjOption = ObjListIE.Document.createElement("OPTION")
        ObjSelect.Options.Add ObjOption
        ObjOption.text = item
        ObjOption.Value = item
    Next
    
    ' SELECTタグに改行を追加
    Set ObjLF = ObjListIE.Document.createElement("BR")
    ObjListIE.Document.Body.insertBefore(ObjLF)
    
    ' Cancelボタンを追加
    Set ObjButton1 = ObjListIE.Document.createElement("button")
    ObjButton1.Value = "CANCEL"
    ObjButton1.style.styleFloat = "right"
    ObjListIE.Document.Body.insertBefore(ObjButton1)
    Set ObjButton1.onclick = GetRef("Click_Cancel")
    
    ' OKボタンを追加
    Set ObjButton2 = ObjListIE.Document.createElement("button")
    ObjButton2.Value = "OK"
    ObjButton2.style.styleFloat = "right"
    ObjListIE.Document.Body.insertBefore(ObjButton2)
    Set ObjButton2.onclick = GetRef("Click_OK")

' IEオブジェクトのステータスを設定
    With ObjListIE
        .height     = IE_HEIGHT
        .width      = IE_WIDTH
        .Left       = IE_LEFT
        .Top        = IE_TOP
        .AddressBar = false
        .MenuBar    = false
        .Resizable  = false
        .StatusBar  = false
        .ToolBar    = false
        .Visible    = true
    End With
    
    ObjListIE.Document.title = "ドロップダウン選択"

Do While(ObjListIE.Busy)
        WScript.Sleep 100
    Loop
    
    CreateObject("WScript.Shell").AppActivate "about:blank"

' ボタン押下まで待機
    Do While (ObjListIE.Visible)
        WScript.Sleep 100
    Loop

' OKボタンが押された場合は選択項目を返す
    If (RetVal = "OK") Then
        If (RetType = TYPE_INDEX) Then
            RetVal = ObjSelect.selectedIndex
        Else
            RetVal = ObjSelect.Value
        End If
    Else
        If (RetType = TYPE_INDEX) Then
            RetVal = -1
        Else
            RetVal = STRING_CANCEL
        End If
    End If

' IEオブジェクトを解放
    ObjListIE.Quit
    
    SelectList = RetVal

End Function

' OKボタン押下時
Function Click_OK
    RetVal = "OK"
    ObjListIE.Visible = false
End Function

' CANCELボタン押下時
Function Click_Cancel
    RetVal = "Cancel"
    ObjListIE.Visible = false
End Function

'###########################################################

ドロップダウン選択スクリプト

スクリーンショット