我一直在尝试在 Excel 中的用户窗体上创建按钮和文本框等控件。效果很好，我什至设法使用极简事件处理程序类来捕获事件。
现在我想动态创建一个用户窗体对象来容纳这些控件，我想从 vbscript 中完成它，而不是必须依赖 excel 来处理 vba。
这可以做到吗？
我发现这个 VBA 代码声称可以在 excel/vba 中创建用户窗体对象，但它只使用一些 excel 对象，例如“activeworkbook”。 Creating form programmatically in the module using vba
【问题讨论】：
在 VBScript 中，我们没有表单包，所以我们必须使用其他对象。
Html 文件可以包含 VBScript。如果您将网页重命名为 *.hta，它就像一个程序。
这会搜索硬盘。它有几个 html 控件。
<HTML>
<HEAD><TITLE>Simple Validation</TITLE>
<SCRIPT LANGUAGE="VBScript">
Dim Dirname
Dim Searchterm
Dim FSO
Dim objOutFile
Sub Browse
On Error Resume Next
Set bffShell = CreateObject("Shell.Application")
Set bff = bffShell.BrowseForFolder(0, "Select the My Documents folder", 9)
If Err.number<>0 Then
MsgBox "Error Setting up Browse for Folder"
Else
A = bff.ParentFolder.ParseName(bff.Title).Path
If err.number=424 then err.clear
tb2.value = A
End If
End Sub
Sub Search
' On Error Resume Next
Set WshShell = CreateObject("WScript.Shell")
WshShell.RegWrite "HKCU\Software\StackOverflow\VBS\Searchterm", tb1.value
WshShell.RegWrite "HKCU\Software\StackOverflow\VBS\Directory", tb2.value
Set fso = CreateObject("Scripting.FileSystemObject")
Set objOutFile = fso.CreateTextFile("results.txt",True)
Dirname = tb2.value
Searchterm = tb1.value
ProcessFolder DirName
End Sub
Sub ProcessFolder(FolderPath)
On Error Resume Next
Set fldr = fso.GetFolder(FolderPath)
Set Fls = fldr.files
For Each thing in Fls
Set contents = thing.OpenAsTextStream
If err.number = 0 then
Linenum = 0
Do Until contents.AtEndOfStream
line = contents.readline
Linenum = Linenum + 1
Test = Instr(line, searchterm)
If Isnull(test) = false then If Test > 0 then ObjOutFile.WriteLine LineNum & " " & thing.path
Loop
Else
err.clear
End If
Next
Set fldrs = fldr.subfolders
For Each thing in fldrs
ProcessFolder thing.path
Next
End Sub
Sub Init
On Error Resume Next
Set WshShell = CreateObject("WScript.Shell")
tb1.value = WshShell.RegRead("HKCU\Software\StackOverflow\VBS\Searchterm")
tb2.value = WshShell.RegRead("HKCU\Software\StackOverflow\VBS\Directory")
End Sub
</script>
</head>
<body Onload=Init>
<p><INPUT Name=tb1 TYPE=Text Value="Search">
<p><INPUT Name=tb2 TYPE=Text Value="Folder"> <INPUT NAME="Browse" TYPE="BUTTON" VALUE="Browse" OnClick=Browse>
<p><INPUT NAME="Search" TYPE="BUTTON" VALUE="Search" OnClick=Search>
</body>
</html>
请参阅https://msdn.microsoft.com/en-us/library/ms536495.aspx 了解设置应用图标等属性。
EG
<HTA:APPLICATION ID="oHTA" APPLICATIONNAME="myApp" BORDER="thin" BORDERSTYLE="normal" CAPTION="yes" ICON="" MAXIMIZEBUTTON="yes" MINIMIZEBUTTON="yes" SHOWINTASKBAR="no" SINGLEINSTANCE="no" SYSMENU="yes" VERSION="1.0" WINDOWSTATE="maximize"/>
【讨论】：
最近我在这里找到了 VbsForm：http://maadam.sweb.cz/envbsform.htm。 它可用于动态创建用户表单对象。表单控件的定义由 cmets 完成。 这是我在那里找到的测试代码。将其另存为 form.vbs。在代码中更改 vbsform.exe 的路径 (2x)。运行您的 form.vbs 代码，而不是 VbsForm。
' VB Script Document
option Explicit
'form..definition.begin
'form..delimiter|
'form..dont.close
dim fld'form..field|Input string:|200
dim ofd'form..openfile|Select file:|-1
dim fbd'form..opendir|Select dir:|-1
'form..label|This is a form..label test. Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat.
dim rbt'form..radiobutton||{Radio1|Radio2}
dim chk'form..checkbox|Checkbox:
dim dte'form..date|Date:
dim tme'form..time|Time:
dim dtm'form..datetime|Datetime:
dim cbo'form..combobox|Combobox:|0|{citem1|citem2|citem3|citem4}
dim lst'form..listbox|Listbox:|0|0|{litem1|litem2|litem3|litem4}
dim chl'form..chklistbox|Checklistbox:|-1|0|{form..field|form..openfile|form..opendir|form..radiobutton|form..checkbox|form..date|form..time|form..datetime|form..combobox|form..listbox|form..chklistbox|form..numericupdown}
dim num'form..numericupdown|Number:|1|5
dim sfd'form..savefile|Save file:|-1
'form..definition.end
if WScript.Arguments.Count = 0 then
form_start ""
else
if Wscript.Arguments(0) = "vbsform_exe" then
fld = Wscript.Arguments(1)
ofd = Wscript.Arguments(2)
fbd = Wscript.Arguments(3)
rbt = Wscript.Arguments(4)
chk = Wscript.Arguments(5)
dte = Wscript.Arguments(6)
tme = Wscript.Arguments(7)
dtm = Wscript.Arguments(8)
cbo = Wscript.Arguments(9)
lst = Wscript.Arguments(10)
chl = Wscript.Arguments(11)
num = Wscript.Arguments(12)
sfd = Wscript.Arguments(13)
else
wscript.quit
end if
end if
MsgBox "RETURN: ~fld:" & fld & " ~ofd:" & ofd & " ~fbd:" & fbd & " ~rbt:" & rbt & " ~chk:" & chk & " ~dte:" & dte & " ~tme:" & tme & " ~dtm:" & dtm & " ~cbo:" & cbo & " ~lst:" & lst & " ~chl:" & chl & " ~num:" & num & " ~sfd:" & sfd,,"VBscript from VbsForm"
MsgBox "This is a VBScript MsgBox. You will see another MsgBox after you click OK."
form_msgbox "This is VbsForm MsgBox with a countdown timer set to 10 seconds." & vbNewLine & "VbsForm MsgBox can show either a text or a picture." & vbNewLine & vbNewLine & "Bye. 5 4 3 2 1...", 10
wscript.quit
'______________________________________________________________________________
function form_start(idefnr)
dim objshll
Set objshll = CreateObject("WScript.Shell")
objshll.Run "DRIVE:\path\to\vbsform.exe """ & WScript.ScriptFullName & trim(""" " & idefnr)
wscript.quit
end function
'______________________________________________________________________________
function form_msgbox(itext, itimer)
dim objshll
Set objshll = CreateObject("WScript.Shell")
objshll.Run "DRIVE:\path\to\vbsform.exe """ & itext & """ " & itimer
end function
【讨论】：