Question

我有一个用户表单，我希望html选项值填充excel组合框。基本上我想复制值并稍后传递它们。

我所拥有的是从各个帖子中拼凑而成，但似乎没有任何效果。

Dim appIE As InternetExplorerMedium
Dim nam As Object
Dim sel As Object

Set appIE = New InternetExplorerMedium
sURL = "site infor goes here"
With appIE
    .navigate sURL
    .Visible = True
End With
Do While appIE.Busy Or appIE.readyState <> 4
    DoEvents
Loop
For Each f In IE.document.getElementsByTagName("select")
    If f = "suppliercode" Then
        For Each fOption In IE.document.getElementsByTagName("option")
            With Me.SupplierSite.AddItem(f.Option)
            End With
        Next fOption
    End If
Next f

ALSO TRIED:
Set Doc = IE.document.forms("NewReleaseQueueForm1")
For Each sel In Doc.getElementsByTagName("select")(0).Value
If sel.Name = "suppliercode" Then
'loop through and add each option to Me.SupplierSite
For Each opt In IE.document.forms("NewReleaseQueueForm1").getElementsByTagName("option")(0).Value
Me.SupplierSite.AddItem sel.Value
Next opt
End If
Next sel

HTML示例：

<form id="NewReleaseQueueForm1" method="post" name="NewReleaseQueueForm1">
    <table cellpadding="4">
        <tr>
            <th valign="top">Supplier Site</th>
            <td valign="top">
                <select multiple name="suppliercode" size="5">
                    <option selected value="Any">
                        &lt;Any&gt;
                    </option>
                    <option value="T488C">
                        T488C
                    </option>
                </select>
            </td>
            <td></td>

Answer 1

请将以下HTML代码放入记事本中并另存为HTML文件。在MSIE中打开该文件

然后打开一个新的干净工作簿并将下面的宏代码粘贴到标准模块中。确保您的网页在MSIE中打开。转到编辑器并将光标放在＆＃34; StartHere（）＆＃34;子程序。按PF5运行它。将打开一个userform，其中包含所有打开的打开的浏览器页面的名称。选择标题为＆＃34;测试获取选择选项＆＃34;的那个。 msgbox似乎表示该页面已成功放入Excel对象。然后检查您的工作表，看它是否列出了A列中的四个选项。

如果有效，请清除sheet1并打开您的网页。再次尝试使用宏，看看9it是否适用于您的页面。

<强> HTML：代码

<template name="Recorrido_mapa">
    {{> Map}}
    {{> Linea_card  notUnique=false}}
</template>

宏代码：

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> <html lang="en"> 
<head> 
<meta http-equiv="content-type" content="text/html; charset=utf-8"> 
<title>Test Get Select Options</title> 
</head> 
<body> 

<form id="NewReleaseQueueForm1" method="post" name="NewReleaseQueueForm1">
    <table cellpadding="4">
        <tr>
            <th valign="top">Supplier Site</th>
            <td valign="top">
                <select multiple name="suppliercode" size="5">
                    <option selected value="Any">
                        &lt;Any&gt;
                    </option>
                    <option value="T488C">
                        T488C
                    </option>
                    <option value="R488C">
                        R488C
                    </option>
                    <option value="C488C">
                        C488C
                    </option>
                    <option value="Z488C">
                        Z488C
                    </option>
                </select>
            </td>
            <td></td>
       </tr>
   </table>
</form>
</body> 
</html>

Answer 2

只需通过VB编辑器自己在干净的工作簿中添加引用＆＃34;工具＆＃34; - ＆＃34;参考文献。＆＃34;他们是＆＃39; Microsoft Scripting Runtime ，＆＃39; Microsoft Forms ，＆＃39; < strong> Microsoft MSHTML ，以及＆＃39; Microsoft Internet Controls 。然后将以下代码添加到模块中并运行getOpenBrowserCreateForm（）。它已经为我工作了多年

Global myDoc As HTMLDocument
Global IE As Object


Sub getOpenBrowserCreateForm()
Dim myForm As Object
Dim NewFrame As MSForms.Frame
Dim NewButton As MSForms.CommandButton, newButton2 As MSForms.CommandButton
'Dim NewComboBox As MSForms.ComboBox
Dim NewListBox As MSForms.ListBox
'Dim NewTextBox As MSForms.TextBox
'Dim NewLabel As MSForms.Label
'Dim NewOptionButton As MSForms.OptionButton
'Dim NewCheckBox As MSForms.CheckBox
Dim x As Integer
Dim Line As Integer

'This is to stop screen flashing while creating form
Application.VBE.MainWindow.Visible = False

On Error Resume Next
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Windows\System32\mshtml.tlb"
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Windows\System32\ieframe.dll"
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Windows\system32\scrrun.dll"
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Windows\system32\FM20.DLL"
On Error GoTo 0
Set myForm = ThisWorkbook.VBProject.VBComponents.Add(3)

'Create the User Form
With myForm
    .Properties("Caption") = "Select Open Web Site"
    .Properties("Width") = 326
    .Properties("Height") = 280
End With

'Create ListBox
Set NewListBox = myForm.designer.Controls.Add("Forms.listbox.1")
With NewListBox
    .Name = "ListBox1"
    .Top = 12
    .Left = 12
    .Width = 297
    .Height = 207.8
    .Font.Size = 9
    .Font.Name = "Tahoma"
    .BorderStyle = fmBorderStyleOpaque
    .SpecialEffect = fmSpecialEffectSunken
End With

'Create CommandButton1 Create
Set NewButton = myForm.designer.Controls.Add("Forms.commandbutton.1")
With NewButton
    .Name = "CommandButton1"
    .Caption = "Select"
    .Accelerator = "M"
    .Top = 228
    .Left = 234
    .Width = 72
    .Height = 24
    .Font.Size = 9
    .Font.Name = "Tahoma"
    .BackStyle = fmBackStyleOpaque
End With

'Create CommandButton2 Create
Set NewButton = myForm.designer.Controls.Add("Forms.commandbutton.1")
With NewButton
    .Name = "CommandButton2"
    .Caption = "Cancel"
    .Accelerator = "M"
    .Top = 228
    .Left = 144
    .Width = 72
    .Height = 24
    .Font.Size = 9
    .Font.Name = "Tahoma"
    .BackStyle = fmBackStyleOpaque
End With

'add code for form module
myForm.codemodule.insertlines 1, "Private Sub CommandButton1_Click()"
myForm.codemodule.insertlines 2, "Dim urlLocation As String"
myForm.codemodule.insertlines 3, ""
myForm.codemodule.insertlines 4, "''////////////////////////////////////////////////////////////////////"
myForm.codemodule.insertlines 5, "''  This part gets all open web pages qand displays them on the form for user to choose"
myForm.codemodule.insertlines 6, "''"
myForm.codemodule.insertlines 7, "    Set objIterator = CreateObject(" & Chr(34) & "Shell.Application" & Chr(34) & ")"
myForm.codemodule.insertlines 8, "    For X = 0 To objIterator.Windows.Count"
myForm.codemodule.insertlines 9, "        On Error Resume Next"
myForm.codemodule.insertlines 10, "        current_title = objIterator.Windows(X).Document.Title"
myForm.codemodule.insertlines 11, "        current_url = objIterator.Windows(X).Document.Location"
myForm.codemodule.insertlines 12, "    "
myForm.codemodule.insertlines 13, "        If current_title = ListBox1.Value Then 'is this my webpage?"
myForm.codemodule.insertlines 14, "        "
myForm.codemodule.insertlines 15, "            Set IE = objIterator.Windows(X)"
myForm.codemodule.insertlines 16, "            MsgBox " & Chr(34) & "IE was properly set" & Chr(34) & ""
myForm.codemodule.insertlines 17, "            "
myForm.codemodule.insertlines 18, "             Boolean_indicator = True"
myForm.codemodule.insertlines 19, "            Exit For"
myForm.codemodule.insertlines 20, "        End If"
myForm.codemodule.insertlines 21, "    Next"
myForm.codemodule.insertlines 22, "    Set objIterator = Nothing"
myForm.codemodule.insertlines 23, "    Set myDoc = IE.Document"
myForm.codemodule.insertlines 24, "Return"
myForm.codemodule.insertlines 25, "Unload Me"
myForm.codemodule.insertlines 26, ""
myForm.codemodule.insertlines 27, "End Sub"
myForm.codemodule.insertlines 28, ""
myForm.codemodule.insertlines 29, ""
myForm.codemodule.insertlines 30, "Private Sub CommandButton2_Click()"
myForm.codemodule.insertlines 31, " Unload Me"
myForm.codemodule.insertlines 32, "End Sub"
myForm.codemodule.insertlines 33, ""
myForm.codemodule.insertlines 34, ""
myForm.codemodule.insertlines 35, "Private Sub UserForm_Activate()"
myForm.codemodule.insertlines 36, "    Dim myArray1() As String, tempNumb As Integer"
myForm.codemodule.insertlines 37, "    "
myForm.codemodule.insertlines 38, "    "
myForm.codemodule.insertlines 39, "    i = 2"
myForm.codemodule.insertlines 40, "    tempNumb = 1"
myForm.codemodule.insertlines 41, "    "
myForm.codemodule.insertlines 42, "    ReDim myArray1(1 To 1)"
myForm.codemodule.insertlines 43, "   "
myForm.codemodule.insertlines 44, "    Set objShell = CreateObject(" & Chr(34) & "Shell.Application" & Chr(34) & ")"
myForm.codemodule.insertlines 45, "    Set objAllWindows = objShell.Windows"
myForm.codemodule.insertlines 46, "    "
myForm.codemodule.insertlines 47, "    "
myForm.codemodule.insertlines 48, "    For Each ow In objAllWindows"
myForm.codemodule.insertlines 49, "        If (InStr(1, ow," & Chr(34) & "Internet Explorer" & Chr(34) & ", vbTextCompare)) Then"
myForm.codemodule.insertlines 50, "            myArray1(tempNumb) = ow.Document.Title"
myForm.codemodule.insertlines 51, "            tempNumb = tempNumb + 1"
myForm.codemodule.insertlines 52, "            If Not ow.Document.Title = " & Chr(34) & "" & Chr(34) & " Then"
myForm.codemodule.insertlines 53, "                ReDim Preserve myArray1(1 To tempNumb)"
myForm.codemodule.insertlines 54, "            Else"
myForm.codemodule.insertlines 55, "                Exit For"
myForm.codemodule.insertlines 56, "            End If"
myForm.codemodule.insertlines 57, "        End If"
myForm.codemodule.insertlines 58, "    Next"
myForm.codemodule.insertlines 59, "     "
myForm.codemodule.insertlines 60, "    Me.ListBox1.List = myArray1"
myForm.codemodule.insertlines 61, "End Sub"
myForm.codemodule.insertlines 62, ""
'Show the form
VBA.UserForms.Add(myForm.Name).Show

'Delete the form (Optional)
Application.VBE.MainWindow.Visible = True

ThisWorkbook.VBProject.VBComponents.Remove myForm

'   IE is now set to the user's choice and you can add code here to interact with it
'   myDoc is now set to IE.Document also
'
'
'

Dim drp As HTMLFormElement

Set drp = myDoc.getelementsbyname("suppliercode")(0)



Dim walekuj As Long
walekuj = myDoc.forms.Length
 MsgBox walekuj

'we get the option values into our worksheet

For x = 0 To 3
 Cells(x + 1, 1) = drp.Item(x).innerText
 Next x

'Now we select the option value of our choice

drp.selectedIndex = 2

' we free memory

Set IE = Nothing
 Application.StatusBar = ""
End Sub

使用vba从html组合框填充excel用户表单组合框

2 个答案: