從html組合框填充excel用戶表單組合框與vba

我有一個用戶表單，我希望html選項值填充excel組合框。基本上我想複製這些值並在稍後傳遞它們。從html組合框填充excel用戶表單組合框與vba

我所擁有的東西是從各種帖子一起粉碎的，但似乎沒有任何工作。

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>

來源

2017-05-02 Noisewater

如果f.name =「suppliercode」那麼???嘗試一下，並通過調試 –

它似乎不喜歡.additem，它跳過if語句。 .additem上的預期函數或變量。我用我試過的東西更新了這個線程 – Noisewater

嘗試將行改爲「if f.NAME =」suppliercode「Then」「for循環中的一些其他代碼也不起作用。以下鏈接將引導您完成從select元素獲取選項的過程。它使用GetElementById方法，您可以使用GetElementsByName（「suppliercode」）（0）方法替換該方法。零是必要的，因爲可能有多個名爲「suppliercode」的元素。 0表示第一個實例，1表示第二個實例等等。http://www.exceltrainingvideos.com/tag/get-option-values-from-drop-down-list-with-vba/ –

我得到了這個工作。感謝您爲發佈內容所付出的時間和精力。

Set IE = IE.document.frames(1).document 
Dim supls As Object 
Dim suplsDrop As Object 
Set suplsDrop = IE.getElementsByTagName("OPTION") 
For Each supls In IE.getElementsByTagName("SELECT") 
    If supls.Name = "suppliercode" Then 
For Each suplsDrop In supls 
    With Me.SupplierSite 
    .AddItem suplsDrop.Value 
    End With 
Next suplsDrop 
End If 
Next supls

來源

2017-05-12 12:37:09 Noisewater

請將下列HTML代碼到記事本，並保存爲HTML文件。在MSIE中打開該文件

然後打開一個新的乾淨工作簿並將以下宏代碼粘貼到標準模塊中。確保您的網頁在MSIE中打開。轉到編輯器並將光標放在「StartHere（）」子例程內的某處。按PF5運行它。用戶窗體將打開所有打開的打開的瀏覽器頁面的名稱。選擇標題爲「Test Get Select Options」的那個。一個msgbox會顯示該頁面已成功放入Excel對象中。然後檢查你的工作表，看它是否列出了列A中的四個選項。

如果它工作，然後清除表1並打開你的網頁。再次嘗試宏並查看9it是否適用於您的頁面。

HTML：代碼

<!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>

宏代碼： - 「參考」

Global myDoc As HTMLDocument 
Global IE As Object 
Sub StartHere() 
    On Error Resume Next 
     ThisWorkbook.VBProject.References.AddFromGuid "{420B2830-E718-11CF-893D-00A0C9054228}", 0, 0 'Microsoft Scripting Runtime 
     ThisWorkbook.VBProject.References.AddFromGuid "{0002E157-0000-0000-C000-000000000046}", 0, 0 'Microsoft Extensability for VBA 
     ThisWorkbook.VBProject.References.AddFromGuid "{0D452EE1-E08F-101A-852E-02608C4D0BB4}", 0, 0 'Microsoft Forms 
     ThisWorkbook.VBProject.References.AddFromGuid "{3050F1C5-98B5-11CF-BB82-00AA00BDCE0B}", 0, 0 'Microsoft MSHTML 
     ThisWorkbook.VBProject.References.AddFromGuid "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}", 0, 0 'Microsoft Internet Controls 
    On Error GoTo 0 
Call nextSub 
End Sub 
Sub nextSub() 
     Dim VBProj As VBIDE.VBProject 
     Dim VBComp As VBIDE.VBComponent 
     Dim CodeMod As VBIDE.codemodule 
     Dim LineNum As Long 
     Set VBProj = ActiveWorkbook.VBProject 
     Set VBComp = VBProj.VBComponents("Module1") 
     Set CodeMod = VBComp.codemodule 
     LineNum = 1 
     CodeMod.insertlines 1, "Global myDoc As HTMLDocument" 
     CodeMod.insertlines 2, "Global IE As Object" 
     Call getOpenBrowserCreateForm 
End Sub 
Sub removeCode() 
     Set VBProj = ActiveWorkbook.VBProject 
     Set VBComp = VBProj.VBComponents("Module1") 
     Set CodeMod = VBComp.codemodule 
     LineNum = 1 
    For i = 34 To 4 Step -1 
      CodeMod.DeleteLines i 
    Next i 
End Sub 
Public myDoc As HTMLDocument 
Public 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

來源

2017-05-04 17:06:48

用戶定義類型未定義在'全球myDoc作爲HTMLDocument'和子從不退出。總是在結束之前進入預期的結束子線.. – Noisewater

我的不好。首先擦除兩個全局變量。在添加guid引用後，它將替換它們。 –

就在自己空的工作通過VB編輯器中添加referecnes 「工具」他們是 'Microsoft腳本運行時，' Microsoft表單， '微軟MSHTML，和' Microsoft Internet控制。然後將下面的代碼添加到模塊中並運行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

來源

2017-05-08 16:52:54

從html組合框填充excel用戶表單組合框與vba

回答

相關問題