Sub
WebBrowser
s() '自动添加自定义附加控件
Dim x, y, ie, win, myf, myForm
On Error Resume Next '以下添加引用Extensibility5.3/interent1.1
Set myr = ThisWorkbook.VBProject.References.AddFromGuid _
("{0002E157-0000-0000-C000-000000000046}", 5, 3)
Set mys = ThisWorkbook.VBProject.References.AddFromGuid _
("{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}", 1, 1)
Set ie = CreateObject("htmlfile")
Set win = ie.parentwindow '获取屏幕/高度宽度
x = win.screen.Height / 3: y = win.screen.Width / 3
Set myf = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
With myf
.Properties("Caption") = "WebBrowser"
.Properties("Height") = x '窗体高度
.Properties("Width") = y '窗体宽度
End With
Set myForm = myf.Designer '添加附加控件
With myForm.Controls.Add(bstrprogid:="Shell.Explorer.2")
.Top = 0 '控件与窗体上边框距离
.Left = 0 '控件与窗体左边框距离
.Height = x '控件高度
.Width = y '控件宽度
End With
With myf.CodeModule
.DeleteLines 1, .CountOfLines '为控件编写程序代码
.InsertLines 1, "Private Sub UserForm_Initialize()"
.InsertLines 2, Space(4) & "URL= ""http://www.baidu.com/"""
.InsertLines 3, Space(4) & "WebBrowser1.Navigate URL"
.InsertLines 4, "End Sub"
End With
UserForms.Add(myf.Name).Show '显示自定义附加控件
ThisWorkbook.VBProject.VBComponents.Remove myf '退出即删除
End Sub