填充使用 Select2 创建的 HTML 个输入框
Filling HTML Input Boxes That Were Created With Select2
我正在使用 Excel VBA 来自动化网页。 "Select" 个盒子和 "Input" 个盒子是由一个名为 "Select2."
的 jQuery 平台创建的
当用户单击 "Select box"（显示为输入框）时，会弹出一个下拉框，要求用户输入两个字符。我发现您可以使用此命令通过插入 select 框 ID 将有效数据项添加到此框中。
myDoc.parentWindow.execScript "$('#s2id_broomCloset').val('Swiffer - Model 2010').trigger('change')"
大部分输入框与其他任何输入框一样，您可以使用
更改它们
myDoc.GetElementByID("broomCloset").value = "Swiffer"
但是，有一个使用 Select2 构建的输入框，其中包含一个验证下拉列表，要求用户键入前两个字符，并列出姓氏以这两个字符开头的员工。然后用户应该 select 列表中的员工。
此输入框绑定到“
我能够使用
的建议
我已经尝试了所有我能想到的方法来在此输入框中输入有效的回复。以下是一些失败的尝试：
myDoc.GetElementByID("s2id_beanCounter").Children(0).Clicik
myDoc.parentWindow.execScript "$('#s2id_beanCounter').trigger('onclick')"
如果您能引导我回答如何将有效输入输入此框或至少如何单击该框以显示下拉列表，那将是一个巨大的帮助。
2017 年 6 月 20 日编辑
使用@dee 的建议，我能够将姓氏输入到可搜索的输入元素中，并且它会下拉所有具有该姓氏的人。从下面的 html 代码可以看出，下拉框中的名字被突出显示。
当我将鼠标悬停在任何名称上时，鼠标下方的名称将成为突出显示的名称。当然，单击鼠标左键会在输入框中输入该名称。
我如何自动化从 UL 列表中突出显示我们需要的名称并单击它以将其作为有效值输入输入框的过程？
关于此搜索的一个警告是它只搜索姓氏。
<div class="select2-drop select2-display-none bigdrop select2-with-searchbox select2-drop-active" id="select2-drop" style="left: 1049.13px; top: 227.83px; width: 238px; display: block;">
<div class="select2-search">
<input class="select2-input" spellcheck="false" type="text" autocomplete="off" autocapitalize="off" autocorrect="off">
</div>
<ul class="select2-results">
<li class="select2-results-dept-0 select2-result select2-result-selectable select2-highlighted">
<div class="select2-result-label">
<div>JOSEPH MENGELA (ARGENTINA)</div></div>
</li>
<li class="select2-results-dept-0 select2-result select2-result-selectable">
<div class="select2-result-label">
<div>TOMMY MENGELA (ITALY)</div>
</div>
</li>
<li class="select2-results-dept-0 select2-result select2-result-selectable">
<div class="select2-result-label">
<div>SUSAN H MENGELA (POLAND)</div>
</div>
</li>
</ul>
</div>
这是我用来获取下拉框以显示我们系统中具有该姓氏的所有人员姓名的代码。
Set myElement = myDoc.getElementById("s2id_IDofInputBoxHere").Children(0)
SendMouseDownEvent myDoc, myElement
Set myElement = myDoc.getElementById("select2-drop").Children(0).Children(0)
myDoc.getElementById("select2-drop").Children(0).Children(0).Value = "mengela"
' Send input event to trigger searching of text 'BR"
Dim kev
Set kev = myDoc.createEvent("KeyboardEvent")
kev.initEvent "input", True, False
myElement.dispatchEvent kev
For Version 4.0.3 of select 2
解决方案 1
在select2.js中有函数：
this.$selection.on('mousedown', function (evt) {
// Only respond to left clicks
if (evt.which !== 1) {
return;
}
self.trigger('toggle', {
originalEvent: evt
});
});
这个函数处理 selection 的 mousedown 事件所以首先我尝试将 mousedown 发送到 selection 所以我们得到 selection打开然后将文本放入搜索框。最后需要发送输入事件触发搜索。
Sub Select2Demo()
Dim ie As SHDocVw.InternetExplorer
Dim doc As MSHTML.HTMLDocument
Dim url As String
url = "file:///C:/Temp/Whosebug/html/Select2VbaDemo.html"
Set ie = New SHDocVw.InternetExplorer
ie.Visible = True
ie.navigate url
While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
DoEvents
Wend
Set doc = ie.document
' Open drop down
Dim sp As HTMLSpanElement
Set sp = doc.querySelector("span[class^=select2-selection]")
SendMouseDownEvent doc, sp
' Put value into search box
Dim inp
Set inp = doc.querySelector("input[class=select2-search__field]")
inp.Value = "BR"
' Send input event to trigger searching of text 'BR"
Dim kev
Set kev = doc.createEvent("KeyboardEvent")
kev.initEvent "input", True, False
inp.dispatchEvent kev
'ie.Quit
End Sub
Private Sub SendMouseDownEvent(doc As MSHTML.HTMLDocument, target As IEventTarget)
Dim mev As Object
Dim eventType As String
Dim canBubble As Boolean
Dim cancelable As Boolean
Dim viewArg As IHTMLWindow2
Dim detailArg As Long
Dim screenXArg As Long
Dim screenYArg As Long
Dim clientXArg As Long
Dim clientYArg As Long
Dim ctrlKeyArg As Boolean
Dim altKeyArg As Boolean
Dim shiftKeyArg As Boolean
Dim metaKeyArg As Boolean
Dim buttonArg As Object ' Unsupported Variant-Type
Dim relatedTargetArg As IEventTarget
Set mev = doc.createEvent("MouseEvent")
eventType = "mousedown"
canBubble = True
cancelable = False
Set viewArg = doc.parentWindow
Set relatedTargetArg = target
mev.initMouseEvent eventType, canBubble, cancelable, viewArg, _
detailArg, screenXArg, screenYArg, clientXArg, clientYArg, _
ctrlKeyArg, altKeyArg, shiftKeyArg, metaKeyArg, buttonArg, _
relatedTargetArg
target.dispatchEvent mev
End Sub
解决方案 2
其他想法是将 focus 放入 selection 并简单地发送 {ENTER}，这与用户打开 selection 时相同。
我们需要打开 selection，因为这样 input 将被添加到 DOM（否则它不存在）。以下代码对我有用。
注意 SetFocusIE，它确保 IE-Window 处于活动状态，因此 SendKeys 将以右侧 window 为目标。 HTH.
Option Explicit
' Add reference to Microsoft Internet Controls (SHDocVw)
' Add reference to Microsoft HTML Object Library
Private Declare Function SetFocusIE Lib "user32" Alias "SetFocus" _
(ByVal hwnd As Long) As Long
Sub Select2Demo2()
Dim ie As SHDocVw.InternetExplorer
Dim doc As MSHTML.HTMLDocument
Dim url As String
url = "file:///C:/Temp/Whosebug/html/Select2VbaDemo.html"
Set ie = New SHDocVw.InternetExplorer
ie.Visible = True
ie.navigate url
While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
DoEvents
Wend
Set doc = ie.document
Dim sp As HTMLSpanElement
Set sp = doc.querySelector("span[class^=select2-selection]")
sp.Click ' Selection gets focus
SetFocusIE ie.hwnd ' IE gets active window
SendKeys "~", True ' Sends ENTER: Selection opens
' put value to search box then
Dim inp
Set inp = doc.querySelector("input[class=select2-search__field]")
inp.Value = "BR"
ie.Quit
End Sub
Sample page used
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<!-- saved from url=(0016)http://localhost -->
<meta content="text/html; charset=utf-8" http-equiv="Content-Type" />
<script type="text/javascript" src="https://code.jquery.com/jquery-2.2.4.min.js"></script>
<link href="https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.3/css/select2.min.css" rel="stylesheet" />
<script type="text/javascript" src="https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.3/js/select2.js"></script>
<title>Untitled 1</title>
</head>
<body>
<script type="text/javascript">
$(document).ready(function() {
$("#s2id_beanCounter").select2();
});
</script>
<div class="s2-example" >
<label class="control-label" for="s2id_beanCounter">
Enter Employee Name
<select class="js-example-basic-single js-states form-control" id="s2id_beanCounter" style="width:100%">
<option value="JD">John Doe</option>
<option value="BL">Bruce Lee</option>
</select>
</label>
</div>
</body>
</html>
Result im IE
EDIT: For Version 3.4.1 of select2
在版本 3.4.1 中看起来有所不同。这个函数负责 select 突出显示的元素：
this.dropdown.on("mouseup", resultsSelector, this.bind(function (e) {
if ($(e.target).closest(".select2-result-selectable").length > 0) {
this.highlightUnderEvent(e);
this.selectHighlighted(e);
}
}));
所以下面的代码可以用来高亮显示和select过滤的元素之一。 HTH
Option Explicit
' Add reference to Microsoft Internet Controls (SHDocVw)
' Add reference to Microsoft HTML Object Library
Sub Select2DemoVersion341()
Dim ie As SHDocVw.InternetExplorer
Dim doc As MSHTML.HTMLDocument
Dim url As String
url = "file:///C:/Temp/Whosebug/html/select2demo/Select2VbaDemo.html"
Set ie = New SHDocVw.InternetExplorer
ie.Visible = True
ie.navigate url
While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
DoEvents
Wend
Set doc = ie.document
' Get reference to target serach input box before select2 starts to mess up with the DOM when the select opens
Dim inp As HTMLInputElement
Set inp = doc.querySelector("div[class^=select2-container] input[class=select2-input]")
' Open drop down
Dim select2Choice As HTMLAnchorElement
Set select2Choice = doc.querySelector("a[class^=select2-choice]")
SendMouseEvent doc, select2Choice, "mousedown"
' Put value into search box
inp.Value = "mengela"
' Send input event to trigger searching of text 'mengela"
Dim kev
Set kev = doc.createEvent("KeyboardEvent")
kev.initEvent "input", True, False
inp.dispatchEvent kev
' Get the search results
Dim selectResultUl As HTMLUListElement
Set selectResultUl = doc.querySelector("ul[class=select2-results]")
If selectResultUl.Children.Length = 1 Then
' Verify 'No results found' posibility
If selectResultUl.Children(0).className = "select2-no-results" Then
MsgBox "No results"
ie.Quit
Exit Sub
End If
End If
' Deselect currently selected item by removing select2-highlighted class
Dim selectedResultsLis As IHTMLElementCollection
Dim selectResultsLi As HTMLLIElement
Set selectedResultsLis = selectResultUl.getElementsByTagName("li")
For Each selectResultsLi In selectedResultsLis
If selectResultsLi.className Like "*select2-highlighted*" Then
selectResultsLi.className = VBA.Strings.Replace(selectResultsLi.className, "select2-highlighted", "")
Exit For
End If
Next selectResultsLi
' Select another li-element, e.g. last one by adding select2-highlighted class
Dim newSelectionLi As HTMLLIElement
Set newSelectionLi = selectedResultsLis(selectedResultsLis.Length - 1)
newSelectionLi.className = newSelectionLi.className & " select2-highlighted"
' Send mouseup to result label to select the highligted element
Dim resultLabel As HTMLDivElement
Set resultLabel = newSelectionLi.getElementsByClassName("select2-result-label")(0)
SendMouseEvent doc, resultLabel, "mouseup"
'ie.Quit
End Sub
Private Sub SendMouseEvent(doc As MSHTML.HTMLDocument, target As IEventTarget, eventTypeVal)
Dim mev As Object
Dim eventType As String
Dim canBubble As Boolean
Dim cancelable As Boolean
Dim viewArg As IHTMLWindow2
Dim detailArg As Long
Dim screenXArg As Long
Dim screenYArg As Long
Dim clientXArg As Long
Dim clientYArg As Long
Dim ctrlKeyArg As Boolean
Dim altKeyArg As Boolean
Dim shiftKeyArg As Boolean
Dim metaKeyArg As Boolean
Dim buttonArg As Object ' Unsupported Variant-Type
Dim relatedTargetArg As IEventTarget
Set mev = doc.createEvent("MouseEvent")
eventType = eventTypeVal
canBubble = True
cancelable = False
Set viewArg = doc.parentWindow
Set relatedTargetArg = target
mev.initMouseEvent eventType, canBubble, cancelable, viewArg, _
detailArg, screenXArg, screenYArg, clientXArg, clientYArg, _
ctrlKeyArg, altKeyArg, shiftKeyArg, metaKeyArg, buttonArg, _
relatedTargetArg
target.dispatchEvent mev
End Sub
3.4.1 版 select2.js/css 的演示页面可以从我的 dropbox 下载 zip 文件。
这段代码是在上面Dee的帮助下得出的，所以如果你觉得它有用请给他点个赞。 Select2 是 select 框的插件助手，但在本例中它使用了 "input" 框，因此从下拉列表中找到 select 的方法与 [=15] 有点不同=]箱子。您可能需要调整 'children' 元素以满足您的特定需求。在这里找到正确的元素是反复试验，因为它们既没有名称也没有 ID。
Sub open_EMPLOYEE_name_box_1()
Dim ie As SHDocVw.InternetExplorer, _
i As Long, objShell, objAllWindows, ow, myElement As IEventTarget, _
myArray1() As String, tempNumb As Integer, myDoc As HTMLDocument, kev
i = 2: tempNumb = 1: ReDim myArray1(1 To 1):
ReDim myArray1(1 To 1): Set objShell = CreateObject("Shell.Application")
Set objAllWindows = objShell.Windows
For Each ow In objAllWindows
If (InStr(1, ow, "Internet Explorer", vbTextCompare)) Then
If ow.document.Title = "Company Name : Company Page" Then
Set ie = ow
Set myDoc = ie.document
GoTo mainProg
End If
tempNumb = tempNumb + 1
If Not ow.document.Title = "" Then
ReDim Preserve myArray1(1 To tempNumb)
Else
Exit For
End If
i = i + 1
End If
Next
mainProg:
'///////////////////// THIS BRINGS UP THE SMITH LIST
Set myElement = myDoc.getElementById("s2id_employeeName").Children(0)
SendMouseDownEvent myDoc, myElement
Set myElement = myDoc.getElementById("s2id_employeeName").Children(0)
Set myElement = myDoc.getElementById("select2-drop").Children(0).Children(0)
myElement.Value = "Smith"
Set kev = myDoc.createEvent("KeyboardEvent")
kev.initEvent "input", True, False
myElement.dispatchEvent kev
'/////////////////////////// THIS SELECTS "STEVEN R BISHOP (HEBRON)"
Application.Wait Now + #12:00:03 AM# ' 3 second wait for dropdown box to finish
Set myClassResults = myDoc.getElementsByClassName("select2-result-label")
For Each cl In myClassResults
If cl.innerText = "STEVEN R SMITH (CARMEL)" Then
Set myElement = cl
SendMouseUpEvent myDoc, myElement
End If
Next
endItAll:
Set myClassResults = Nothing
Set myElement = Nothing
Set objAllWindows = Nothing
Set myDoc = Nothing
Set ie = Nothing
End Sub
Private Sub SendMouseDownEvent(doc As MSHTML.HTMLDocument, target As IEventTarget)
Dim mev As Object
Dim eventType As String
Dim canBubble As Boolean
Dim cancelable As Boolean
Dim viewArg As IHTMLWindow2
Dim detailArg As Long
Dim screenXArg As Long
Dim screenYArg As Long
Dim clientXArg As Long
Dim clientYArg As Long
Dim ctrlKeyArg As Boolean
Dim altKeyArg As Boolean
Dim shiftKeyArg As Boolean
Dim metaKeyArg As Boolean
Dim buttonArg As Object ' Unsupported Variant-Type
Dim relatedTargetArg As IEventTarget
Dim kev
Set mev = doc.createEvent("MouseEvent")
eventType = "mousedown"
canBubble = True
cancelable = False
Set viewArg = doc.parentWindow
Set relatedTargetArg = target
mev.initMouseEvent eventType, canBubble, cancelable, viewArg, _
detailArg, screenXArg, screenYArg, clientXArg, clientYArg, _
ctrlKeyArg, altKeyArg, shiftKeyArg, metaKeyArg, buttonArg, _
relatedTargetArg
target.dispatchEvent mev
End Sub
Private Sub SendMouseUpEvent(doc As MSHTML.HTMLDocument, target As IEventTarget)
Dim mev As Object
Dim eventType As String
Dim canBubble As Boolean
Dim cancelable As Boolean
Dim viewArg As IHTMLWindow2
Dim detailArg As Long
Dim screenXArg As Long
Dim screenYArg As Long
Dim clientXArg As Long
Dim clientYArg As Long
Dim ctrlKeyArg As Boolean
Dim altKeyArg As Boolean
Dim shiftKeyArg As Boolean
Dim metaKeyArg As Boolean
Dim buttonArg As Object ' Unsupported Variant-Type
Dim relatedTargetArg As IEventTarget
Dim kev
Set mev = doc.createEvent("MouseEvent")
eventType = "mouseup"
canBubble = True
cancelable = False
Set viewArg = doc.parentWindow
Set relatedTargetArg = target
mev.initMouseEvent eventType, canBubble, cancelable, viewArg, _
detailArg, screenXArg, screenYArg, clientXArg, clientYArg, _
ctrlKeyArg, altKeyArg, shiftKeyArg, metaKeyArg, buttonArg, _
relatedTargetArg
target.dispatchEvent mev
End Sub
我正在使用 Excel VBA 来自动化网页。 "Select" 个盒子和 "Input" 个盒子是由一个名为 "Select2."
的 jQuery 平台创建的当用户单击 "Select box"（显示为输入框）时，会弹出一个下拉框，要求用户输入两个字符。我发现您可以使用此命令通过插入 select 框 ID 将有效数据项添加到此框中。
myDoc.parentWindow.execScript "$('#s2id_broomCloset').val('Swiffer - Model 2010').trigger('change')"
大部分输入框与其他任何输入框一样，您可以使用
更改它们myDoc.GetElementByID("broomCloset").value = "Swiffer"
但是，有一个使用 Select2 构建的输入框，其中包含一个验证下拉列表，要求用户键入前两个字符，并列出姓氏以这两个字符开头的员工。然后用户应该 select 列表中的员工。
此输入框绑定到“
我能够使用
的建议我已经尝试了所有我能想到的方法来在此输入框中输入有效的回复。以下是一些失败的尝试：
myDoc.GetElementByID("s2id_beanCounter").Children(0).Clicik
myDoc.parentWindow.execScript "$('#s2id_beanCounter').trigger('onclick')"
如果您能引导我回答如何将有效输入输入此框或至少如何单击该框以显示下拉列表，那将是一个巨大的帮助。
2017 年 6 月 20 日编辑
使用@dee 的建议，我能够将姓氏输入到可搜索的输入元素中，并且它会下拉所有具有该姓氏的人。从下面的 html 代码可以看出，下拉框中的名字被突出显示。
当我将鼠标悬停在任何名称上时，鼠标下方的名称将成为突出显示的名称。当然，单击鼠标左键会在输入框中输入该名称。
我如何自动化从 UL 列表中突出显示我们需要的名称并单击它以将其作为有效值输入输入框的过程？
关于此搜索的一个警告是它只搜索姓氏。
<div class="select2-drop select2-display-none bigdrop select2-with-searchbox select2-drop-active" id="select2-drop" style="left: 1049.13px; top: 227.83px; width: 238px; display: block;">
<div class="select2-search">
<input class="select2-input" spellcheck="false" type="text" autocomplete="off" autocapitalize="off" autocorrect="off">
</div>
<ul class="select2-results">
<li class="select2-results-dept-0 select2-result select2-result-selectable select2-highlighted">
<div class="select2-result-label">
<div>JOSEPH MENGELA (ARGENTINA)</div></div>
</li>
<li class="select2-results-dept-0 select2-result select2-result-selectable">
<div class="select2-result-label">
<div>TOMMY MENGELA (ITALY)</div>
</div>
</li>
<li class="select2-results-dept-0 select2-result select2-result-selectable">
<div class="select2-result-label">
<div>SUSAN H MENGELA (POLAND)</div>
</div>
</li>
</ul>
</div>
这是我用来获取下拉框以显示我们系统中具有该姓氏的所有人员姓名的代码。
Set myElement = myDoc.getElementById("s2id_IDofInputBoxHere").Children(0)
SendMouseDownEvent myDoc, myElement
Set myElement = myDoc.getElementById("select2-drop").Children(0).Children(0)
myDoc.getElementById("select2-drop").Children(0).Children(0).Value = "mengela"
' Send input event to trigger searching of text 'BR"
Dim kev
Set kev = myDoc.createEvent("KeyboardEvent")
kev.initEvent "input", True, False
myElement.dispatchEvent kev
For Version 4.0.3 of select 2
解决方案 1
在select2.js中有函数：
this.$selection.on('mousedown', function (evt) {
// Only respond to left clicks
if (evt.which !== 1) {
return;
}
self.trigger('toggle', {
originalEvent: evt
});
});
这个函数处理 selection 的 mousedown 事件所以首先我尝试将 mousedown 发送到 selection 所以我们得到 selection打开然后将文本放入搜索框。最后需要发送输入事件触发搜索。
Sub Select2Demo()
Dim ie As SHDocVw.InternetExplorer
Dim doc As MSHTML.HTMLDocument
Dim url As String
url = "file:///C:/Temp/Whosebug/html/Select2VbaDemo.html"
Set ie = New SHDocVw.InternetExplorer
ie.Visible = True
ie.navigate url
While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
DoEvents
Wend
Set doc = ie.document
' Open drop down
Dim sp As HTMLSpanElement
Set sp = doc.querySelector("span[class^=select2-selection]")
SendMouseDownEvent doc, sp
' Put value into search box
Dim inp
Set inp = doc.querySelector("input[class=select2-search__field]")
inp.Value = "BR"
' Send input event to trigger searching of text 'BR"
Dim kev
Set kev = doc.createEvent("KeyboardEvent")
kev.initEvent "input", True, False
inp.dispatchEvent kev
'ie.Quit
End Sub
Private Sub SendMouseDownEvent(doc As MSHTML.HTMLDocument, target As IEventTarget)
Dim mev As Object
Dim eventType As String
Dim canBubble As Boolean
Dim cancelable As Boolean
Dim viewArg As IHTMLWindow2
Dim detailArg As Long
Dim screenXArg As Long
Dim screenYArg As Long
Dim clientXArg As Long
Dim clientYArg As Long
Dim ctrlKeyArg As Boolean
Dim altKeyArg As Boolean
Dim shiftKeyArg As Boolean
Dim metaKeyArg As Boolean
Dim buttonArg As Object ' Unsupported Variant-Type
Dim relatedTargetArg As IEventTarget
Set mev = doc.createEvent("MouseEvent")
eventType = "mousedown"
canBubble = True
cancelable = False
Set viewArg = doc.parentWindow
Set relatedTargetArg = target
mev.initMouseEvent eventType, canBubble, cancelable, viewArg, _
detailArg, screenXArg, screenYArg, clientXArg, clientYArg, _
ctrlKeyArg, altKeyArg, shiftKeyArg, metaKeyArg, buttonArg, _
relatedTargetArg
target.dispatchEvent mev
End Sub
解决方案 2
其他想法是将 focus 放入 selection 并简单地发送 {ENTER}，这与用户打开 selection 时相同。
我们需要打开 selection，因为这样 input 将被添加到 DOM（否则它不存在）。以下代码对我有用。
注意 SetFocusIE，它确保 IE-Window 处于活动状态，因此 SendKeys 将以右侧 window 为目标。 HTH.
Option Explicit
' Add reference to Microsoft Internet Controls (SHDocVw)
' Add reference to Microsoft HTML Object Library
Private Declare Function SetFocusIE Lib "user32" Alias "SetFocus" _
(ByVal hwnd As Long) As Long
Sub Select2Demo2()
Dim ie As SHDocVw.InternetExplorer
Dim doc As MSHTML.HTMLDocument
Dim url As String
url = "file:///C:/Temp/Whosebug/html/Select2VbaDemo.html"
Set ie = New SHDocVw.InternetExplorer
ie.Visible = True
ie.navigate url
While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
DoEvents
Wend
Set doc = ie.document
Dim sp As HTMLSpanElement
Set sp = doc.querySelector("span[class^=select2-selection]")
sp.Click ' Selection gets focus
SetFocusIE ie.hwnd ' IE gets active window
SendKeys "~", True ' Sends ENTER: Selection opens
' put value to search box then
Dim inp
Set inp = doc.querySelector("input[class=select2-search__field]")
inp.Value = "BR"
ie.Quit
End Sub
Sample page used
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<!-- saved from url=(0016)http://localhost -->
<meta content="text/html; charset=utf-8" http-equiv="Content-Type" />
<script type="text/javascript" src="https://code.jquery.com/jquery-2.2.4.min.js"></script>
<link href="https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.3/css/select2.min.css" rel="stylesheet" />
<script type="text/javascript" src="https://cdnjs.cloudflare.com/ajax/libs/select2/4.0.3/js/select2.js"></script>
<title>Untitled 1</title>
</head>
<body>
<script type="text/javascript">
$(document).ready(function() {
$("#s2id_beanCounter").select2();
});
</script>
<div class="s2-example" >
<label class="control-label" for="s2id_beanCounter">
Enter Employee Name
<select class="js-example-basic-single js-states form-control" id="s2id_beanCounter" style="width:100%">
<option value="JD">John Doe</option>
<option value="BL">Bruce Lee</option>
</select>
</label>
</div>
</body>
</html>
Result im IE
EDIT: For Version 3.4.1 of select2
在版本 3.4.1 中看起来有所不同。这个函数负责 select 突出显示的元素：
this.dropdown.on("mouseup", resultsSelector, this.bind(function (e) {
if ($(e.target).closest(".select2-result-selectable").length > 0) {
this.highlightUnderEvent(e);
this.selectHighlighted(e);
}
}));
所以下面的代码可以用来高亮显示和select过滤的元素之一。 HTH
Option Explicit
' Add reference to Microsoft Internet Controls (SHDocVw)
' Add reference to Microsoft HTML Object Library
Sub Select2DemoVersion341()
Dim ie As SHDocVw.InternetExplorer
Dim doc As MSHTML.HTMLDocument
Dim url As String
url = "file:///C:/Temp/Whosebug/html/select2demo/Select2VbaDemo.html"
Set ie = New SHDocVw.InternetExplorer
ie.Visible = True
ie.navigate url
While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
DoEvents
Wend
Set doc = ie.document
' Get reference to target serach input box before select2 starts to mess up with the DOM when the select opens
Dim inp As HTMLInputElement
Set inp = doc.querySelector("div[class^=select2-container] input[class=select2-input]")
' Open drop down
Dim select2Choice As HTMLAnchorElement
Set select2Choice = doc.querySelector("a[class^=select2-choice]")
SendMouseEvent doc, select2Choice, "mousedown"
' Put value into search box
inp.Value = "mengela"
' Send input event to trigger searching of text 'mengela"
Dim kev
Set kev = doc.createEvent("KeyboardEvent")
kev.initEvent "input", True, False
inp.dispatchEvent kev
' Get the search results
Dim selectResultUl As HTMLUListElement
Set selectResultUl = doc.querySelector("ul[class=select2-results]")
If selectResultUl.Children.Length = 1 Then
' Verify 'No results found' posibility
If selectResultUl.Children(0).className = "select2-no-results" Then
MsgBox "No results"
ie.Quit
Exit Sub
End If
End If
' Deselect currently selected item by removing select2-highlighted class
Dim selectedResultsLis As IHTMLElementCollection
Dim selectResultsLi As HTMLLIElement
Set selectedResultsLis = selectResultUl.getElementsByTagName("li")
For Each selectResultsLi In selectedResultsLis
If selectResultsLi.className Like "*select2-highlighted*" Then
selectResultsLi.className = VBA.Strings.Replace(selectResultsLi.className, "select2-highlighted", "")
Exit For
End If
Next selectResultsLi
' Select another li-element, e.g. last one by adding select2-highlighted class
Dim newSelectionLi As HTMLLIElement
Set newSelectionLi = selectedResultsLis(selectedResultsLis.Length - 1)
newSelectionLi.className = newSelectionLi.className & " select2-highlighted"
' Send mouseup to result label to select the highligted element
Dim resultLabel As HTMLDivElement
Set resultLabel = newSelectionLi.getElementsByClassName("select2-result-label")(0)
SendMouseEvent doc, resultLabel, "mouseup"
'ie.Quit
End Sub
Private Sub SendMouseEvent(doc As MSHTML.HTMLDocument, target As IEventTarget, eventTypeVal)
Dim mev As Object
Dim eventType As String
Dim canBubble As Boolean
Dim cancelable As Boolean
Dim viewArg As IHTMLWindow2
Dim detailArg As Long
Dim screenXArg As Long
Dim screenYArg As Long
Dim clientXArg As Long
Dim clientYArg As Long
Dim ctrlKeyArg As Boolean
Dim altKeyArg As Boolean
Dim shiftKeyArg As Boolean
Dim metaKeyArg As Boolean
Dim buttonArg As Object ' Unsupported Variant-Type
Dim relatedTargetArg As IEventTarget
Set mev = doc.createEvent("MouseEvent")
eventType = eventTypeVal
canBubble = True
cancelable = False
Set viewArg = doc.parentWindow
Set relatedTargetArg = target
mev.initMouseEvent eventType, canBubble, cancelable, viewArg, _
detailArg, screenXArg, screenYArg, clientXArg, clientYArg, _
ctrlKeyArg, altKeyArg, shiftKeyArg, metaKeyArg, buttonArg, _
relatedTargetArg
target.dispatchEvent mev
End Sub
3.4.1 版 select2.js/css 的演示页面可以从我的 dropbox 下载 zip 文件。
这段代码是在上面Dee的帮助下得出的，所以如果你觉得它有用请给他点个赞。 Select2 是 select 框的插件助手，但在本例中它使用了 "input" 框，因此从下拉列表中找到 select 的方法与 [=15] 有点不同=]箱子。您可能需要调整 'children' 元素以满足您的特定需求。在这里找到正确的元素是反复试验，因为它们既没有名称也没有 ID。
Sub open_EMPLOYEE_name_box_1()
Dim ie As SHDocVw.InternetExplorer, _
i As Long, objShell, objAllWindows, ow, myElement As IEventTarget, _
myArray1() As String, tempNumb As Integer, myDoc As HTMLDocument, kev
i = 2: tempNumb = 1: ReDim myArray1(1 To 1):
ReDim myArray1(1 To 1): Set objShell = CreateObject("Shell.Application")
Set objAllWindows = objShell.Windows
For Each ow In objAllWindows
If (InStr(1, ow, "Internet Explorer", vbTextCompare)) Then
If ow.document.Title = "Company Name : Company Page" Then
Set ie = ow
Set myDoc = ie.document
GoTo mainProg
End If
tempNumb = tempNumb + 1
If Not ow.document.Title = "" Then
ReDim Preserve myArray1(1 To tempNumb)
Else
Exit For
End If
i = i + 1
End If
Next
mainProg:
'///////////////////// THIS BRINGS UP THE SMITH LIST
Set myElement = myDoc.getElementById("s2id_employeeName").Children(0)
SendMouseDownEvent myDoc, myElement
Set myElement = myDoc.getElementById("s2id_employeeName").Children(0)
Set myElement = myDoc.getElementById("select2-drop").Children(0).Children(0)
myElement.Value = "Smith"
Set kev = myDoc.createEvent("KeyboardEvent")
kev.initEvent "input", True, False
myElement.dispatchEvent kev
'/////////////////////////// THIS SELECTS "STEVEN R BISHOP (HEBRON)"
Application.Wait Now + #12:00:03 AM# ' 3 second wait for dropdown box to finish
Set myClassResults = myDoc.getElementsByClassName("select2-result-label")
For Each cl In myClassResults
If cl.innerText = "STEVEN R SMITH (CARMEL)" Then
Set myElement = cl
SendMouseUpEvent myDoc, myElement
End If
Next
endItAll:
Set myClassResults = Nothing
Set myElement = Nothing
Set objAllWindows = Nothing
Set myDoc = Nothing
Set ie = Nothing
End Sub
Private Sub SendMouseDownEvent(doc As MSHTML.HTMLDocument, target As IEventTarget)
Dim mev As Object
Dim eventType As String
Dim canBubble As Boolean
Dim cancelable As Boolean
Dim viewArg As IHTMLWindow2
Dim detailArg As Long
Dim screenXArg As Long
Dim screenYArg As Long
Dim clientXArg As Long
Dim clientYArg As Long
Dim ctrlKeyArg As Boolean
Dim altKeyArg As Boolean
Dim shiftKeyArg As Boolean
Dim metaKeyArg As Boolean
Dim buttonArg As Object ' Unsupported Variant-Type
Dim relatedTargetArg As IEventTarget
Dim kev
Set mev = doc.createEvent("MouseEvent")
eventType = "mousedown"
canBubble = True
cancelable = False
Set viewArg = doc.parentWindow
Set relatedTargetArg = target
mev.initMouseEvent eventType, canBubble, cancelable, viewArg, _
detailArg, screenXArg, screenYArg, clientXArg, clientYArg, _
ctrlKeyArg, altKeyArg, shiftKeyArg, metaKeyArg, buttonArg, _
relatedTargetArg
target.dispatchEvent mev
End Sub
Private Sub SendMouseUpEvent(doc As MSHTML.HTMLDocument, target As IEventTarget)
Dim mev As Object
Dim eventType As String
Dim canBubble As Boolean
Dim cancelable As Boolean
Dim viewArg As IHTMLWindow2
Dim detailArg As Long
Dim screenXArg As Long
Dim screenYArg As Long
Dim clientXArg As Long
Dim clientYArg As Long
Dim ctrlKeyArg As Boolean
Dim altKeyArg As Boolean
Dim shiftKeyArg As Boolean
Dim metaKeyArg As Boolean
Dim buttonArg As Object ' Unsupported Variant-Type
Dim relatedTargetArg As IEventTarget
Dim kev
Set mev = doc.createEvent("MouseEvent")
eventType = "mouseup"
canBubble = True
cancelable = False
Set viewArg = doc.parentWindow
Set relatedTargetArg = target
mev.initMouseEvent eventType, canBubble, cancelable, viewArg, _
detailArg, screenXArg, screenYArg, clientXArg, clientYArg, _
ctrlKeyArg, altKeyArg, shiftKeyArg, metaKeyArg, buttonArg, _
relatedTargetArg
target.dispatchEvent mev
End Sub