今年大火的ChatGPT似乎无所不能,但是它的确不是万能的,咱们来试试。
提供的代码根本无法运行,继续问,换了个代码,非常不幸的是–还是不能用。
Word VBA中并没有内置的方法可以直接导出图片,ChatGPT没有正确的答案也是可以理解的。
示例代码如下。
Sub ExportInlineShps()Dim intIdx As IntegerDim strPath As StringWith ActiveDocumentIf .InlineShapes.Count > 0 ThenstrPath = .Path & "\"For intIdx = 1 To .InlineShapes.CountsSaveImg .InlineShapes(intIdx), strPath & intIdx & ".png"NextElseMsgBox "文档中没有图片"End IfEnd With
End Sub
【代码解析】
第5行代码判断活动文档中是否存在图片(InlineShape
)。
如果不存在图片,第11行代码将显示提示消息框。
如果存在图片,第11行代码将显示提示消息框。
第6行获取活动文档的目录。
第7~9行代码调用sSaveImg
过程将图片保存为PNG图片。
Sub sSaveImg(ByVal objShp As InlineShape, ByVal strFullPath As String)Const TAG_S = "<pkg:binaryData>"Const TAG_E = "</pkg:binaryData>"Dim objNode As Object 'MSXML2.IXMLDOMElementDim lngStart As Long, lngEnd As LongDim bytImage() As ByteDim strXML As StringDim rngShp As RangestrXML = objShp.Range.WordOpenXMLlngStart = InStr(strXML, TAG_S)If lngStart = 0 ThenMsgBox "无法定位图片数据"Exit SubElselngStart = lngStart + Len(TAG_S)lngEnd = InStr(lngStart, strXML, TAG_E)strXML = Mid$(strXML, lngStart, lngEnd - lngStart)Set objNode = CreateObject("MSXML2.DOMDocument").createElement("b64")objNode.DataType = "bin.base64"objNode.Text = strXMLbytImage = objNode.nodeTypedValueOpen strFullPath For Binary As #1Put #1, 1, bytImageClose #1Set objNode = NothingEnd If
End Sub
【代码解析】
第一个参数为InlineShape
,即Word中的图片,第二个图片是图片文件的全路径。
第2~3行代码定义图片对象XML起始标签和结束标签。
第9行代码获取图片对象的XML代码。
第10行代码查找XML起始标签。
如果无法定位XML起始标签,第12行代码将显示提示消息框。
如果成功定位XML起始标签,第13行代码将获取图片对象(Base64编码)的起始位置。
第16行代码查找XML结束标签。
第17行代码提取图片对象(Base64编码)的XML代码。
第18行代码创建MSXML2.DOMDocument
对象,并增加一个节点。
第19行代码设置数据类型为bin.base64
。
第20行代码将图片对象(Base64编码)的XML代码赋值给节点。
第21行代码读取结点的nodeTypedValue
属性,并保存在Byte
数组中。
第22~24行代码将图片对象保存为硬盘文件。
第25行代码释放对象变量占用的系统资源。