|
楼主 |
发表于 2012-7-22 18:04
|
显示全部楼层
本帖最后由 liucqa 于 2013-4-11 18:25 编辑
四、可以使用WebBrowser控件来导航页面,并遍历图片。这个方法需要熟练掌握控件的使用,适合中高级水平的人使用。
知识点1:使用WebBrowser_DocumentComplete事件来确认网页导航完毕
知识点2:使用API 剪贴板函数来得到图片
知识点3:使用stdole.SavePicture方法保存图片到本地
代码如下:
- Private bLoadComplete As Boolean
- Private Sub CommandButton1_Click()
- Dim Pic As PicBmp, IPic As Picture, IID_IDispatch As Guid
- Dim nUrl As String, localFilename As String, lngRetVal As Long, objElement, n&, nRange
- nUrl = "http://www.baidu.com/" '网址
- localFilename = "Myimg.gif" '保存到本地的文件名
- Label1.Caption = "开始导航页面..."
- frmWB.WebBrowser1.Silent = True '关闭交互 禁止脚本错误
- frmWB.WebBrowser1.Navigate nUrl '开始导航
- bLoadComplete = False
- Do While Not bLoadComplete '等待DocumentComplete事件确认加载结束
- DoEvents
- Loop
- n = 1
- For Each objElement In WebBrowser1.Document.images
- Set nRange = WebBrowser1.Document.body.createControlRange()
- nRange.Add objElement
- nRange.execCommand "Copy" '复制到剪贴板
- OpenClipboard 0 'OpenClipboard
- With IID_IDispatch 'GUID理论上可以随便写,只要和操作系统已有的不重复就行
- .Data1 = &H20400
- .Data4(0) = &HC0
- .Data4(7) = &H46
- End With
- With Pic
- .Size = Len(Pic)
- .Type = 1
- .hBmp = GetClipboardData(CF_BITMAP)
- End With
- OleCreatePictureIndirect Pic, IID_IDispatch, 1, IPic
- stdole.SavePicture IPic, ThisWorkbook.Path & Application.PathSeparator & n & localFilename '图片保存到本地
- CloseClipboard
- Set Image1.Picture = IPic '图片显示到Image控件
- Label1.Caption = "第" & n & "张图片"
- frmWB.Repaint '刷新窗体,以便显示图片
- Sleep 1000
- n = n + 1
- Next
- Set Image1.Picture = Nothing
- Label1.Caption = "图片显示完毕"
- End Sub
- Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
- If pDisp Is WebBrowser1 Then bLoadComplete = True '确认页面加载完毕
- End Sub
复制代码
使用Webbrowser控件可以处理几乎所有的网页,与使用IE相比,用户界面和程序可控性要好一些。
但是窗体中自带的Webbrowser控件目前问题较多,使用时需要仔细调试。
如果想进一步学习Webbrowser控件的使用可以参考下贴
http://club.excelhome.net/forum.php?mod=redirect&goto=findpost&ptid=815805&pid=6110079
|
|