ExcelTip.Net留存知识帖 ---【注:附件之前被网盘供应商清空后,现已修复-现已修复-现已修复为本地下载!】
现在位置:首页 > E问E答 > Excel VBA > 如何用vba代码向Excel中导入网页中带图片或图表的区域?

如何用vba代码向Excel中导入网页中带图片或图表的区域?

作者:绿色风 分类: 时间:2022-08-17 浏览:89
楼主
kevinchengcw
Q: 如何用vba代码向Excel中导入网页中带图片或图表的区域?
A: 实现代码如下:
  1. Option Explicit

  2. '声明用于操作剪贴板的API函数
  3. Private Declare Function OpenClipboard Lib "user32" (ByVal Hwnd _
  4.         As Long) As Long
  5. Private Declare Function CloseClipboard Lib "user32" () As Long
  6. Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat _
  7.         As Long, ByVal hMem As Long) As Long
  8. Private Declare Function EmptyClipboard Lib "user32" () As Long
  9. Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags _
  10.         As Long, ByVal dwBytes As Long) As Long
  11. Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As _
  12.         Long) As Long
  13. Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As _
  14.         Long) As Long
  15. Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As _
  16.         Long) As Long
  17. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
  18.         (Destination As Any, Source As Any, ByVal Length As Long)

  19. Function TextToClip(sData As String) As Boolean  '自定义将文本放入剪贴板的函数
  20. If CBool(OpenClipboard(0)) Then
  21.    Dim hMemHandle&, lpData&
  22.    hMemHandle = GlobalAlloc(0, LenB(sData) + 2)  '申请内存空间
  23.    If CBool(hMemHandle) Then  '如果空间申请成功
  24.       lpData = GlobalLock(hMemHandle)  '锁定内存块,返回地址
  25.       If lpData <> 0 Then  '如果返回有效地址,则
  26.          CopyMemory ByVal lpData, ByVal sData, LenB(sData)  '文本内容复制到对应内存中
  27.          GlobalUnlock hMemHandle  '解除锁定
  28.          EmptyClipboard  '清空剪贴板,以写入新文本
  29.          SetClipboardData 1, hMemHandle  '剪贴板以文本方式指向目标空间
  30.       End If
  31.    End If
  32.    Call CloseClipboard  '关闭剪贴板
  33.    TextToClip = True  '操作成功返回true
  34. Else
  35.     TextToClip = False  '操作失败时返回false
  36. End If
  37. End Function

  38. Sub test()
  39. Dim Str$
  40. With CreateObject("msxml2.xmlhttp")  '创建xmlhttp项目,用于调取网页源码
  41.     .Open "get", "http://cj.gw.com.cn/news/stock/sh601318/baidu_frame_v1.shtml?qk=601318&srcid=14442", False  '读取指定页内容
  42.     .send  '发送请求
  43.     Str = .responsetext  '提取返回内容文本
  44. End With
  45. If TextToClip(Str) Then ActiveSheet.Paste [a1]  '如果成功将文本内容放入剪贴板,则在活动工作A1单元格进行粘贴操作
  46. End Sub
数据导入功能即使用完全Html格式也无法导入图表是个遗憾,本例意在尽力弥补这一缺憾
实现原理:
将数据通过剪贴板粘贴进工作表中,Excel会自动读取网页代码中指定的各项内容(含图片图表等页面附件),从而实现完全导入

以上结合正则等文本处理,可以实现对具体区域表格的定向导入,从而更加灵活

不足:
利用剪贴板操作容易影响用户正常操作

替代构想:
可以尝试用word读取全部网页后转回excel中

详见附件及素材源帖.

VBA导入带图表网页.rar
2楼
xyf2210
谢谢分享学习
3楼
老糊涂
谢谢分享学习

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素, 经与ExcelTip.Net站长Apolloh商议并征得其同意, 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示, 供有需要的人士查询使用,也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议, 可与本人沟通提出,或于本站点留言,我们会尽快处理。 在此,感谢ExcelTip.Net站长Apolloh的支持,感谢本站点所有人**绿色风(QQ:79664738)**的支持与奉献,特此鸣谢!
------本人网名**KevinChengCW(QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表
sitemap