chatgpt搜索的批量导出word内插图片到当前文件夹

zzpsx

Sub a导出文档图片()
    '导出图片

    Dim oPath As String
    oPath = ActiveDocument.path & "\"    '读取当前文档存储路径

    For Each objShape In ActiveDocument.InlineShapes '遍历图片
        If objShape.Type = wdInlineShapePicture Then
            objShape.Range.Select '选中当前图片
            '加上导出格式后缀(wdPNG 导出PNG)。注：cmdCrop剪裁(宽高自控，去黑色边框)
            ActiveDocument.ExportAsFixedFormat OutputFileName:=oPath & _
            objShape.Range.Caption & ".png", _
            ExportFormat:=wdExportFormatPNG, cmdCrop:=True
        End If
    Next

    MsgBox "图片成功导出至" & oPath, vbInformation
End Sub

高个子

上传附件，模拟结果

taller

ChatGPT不是万能的，给出的结果不一定时对的

taller

perfect131

taller 发表于 2023-2-11 12:29

base64转图确实方便，学习了

zzpsx

taller 发表于 2023-2-11 12:29

您好，高手，我用您的代码，结果如下，不知道我代码有没有输错。




Sub ExportInlineShps()
Dim intIdx As Integer
Dim strPath As String
With ActiveDocument
If .InlineShapes.Count > 0 Then
strPath = .Path & "\"
For intIdx = 1 To .InlineShapes.Count
sSaveImg .InlineShapes(intIdx), strPath & intIdx & ".png"
Next
Else
MsgBox "没有图片"
End If
End With
End Sub
Sub sSaveImg(ByVal objShp As InlineShape, ByVal strFullPath As String)
Const TAG_S = "<pkg:binaryData>"
Const TAGE = "</pkg:binaryData>"
Dim objNode As Object 'MSXML2.IXMLDOMElement
Dim IngStart As Long, IngEnd As Long
Dim bytImage() As Byte
Dim strXML As String
Dim rngShp As Range
strXML = objShp.Range.WordOpenXML
1 ngStart = InStr(strXML, TAG_S)
If lngStart = 0 Then
MsgBox "没有图片数据"
Exit Sub
Else
lngStart = lngStart + Len(TAG_S)
lngEnd = InStr(IngStart, strXML, TAGE)
strXML = Mid$(strXML, IngStart, IngEnd - IngStart)
Set objNode = CreateObject("MSXML2.DOMDocument").createELement("b64")
objNode.DataType = "bin. base64"
objNode.Text = strXML
bytImage = objNode.nodeTypedValue
Open strFullPath For Binary As #1
Put #1, 1, bytImage
Close #1
Set objNode = Nothing
End If
End Sub

新建文件夹 (2).rar (33.11 KB, 下载次数: 8)

2023-2-11 16:44 上传

点击文件名下载附件

lss001

zzpsx 发表于 2023-2-11 16:44
您好，高手，我用您的代码，结果如下，不知道我代码有没有输错。

请参考以下链接
https://www.autoahk.com/archives/8322

shenjianrong163

zzpsx 发表于 2023-2-11 16:44
您好，高手，我用您的代码，结果如下，不知道我代码有没有输错。

确实有错的。

base64转图.rar (36.27 KB, 下载次数: 19)

2023-2-11 22:09 上传

点击文件名下载附件

taller

ivccav

taller 发表于 2023-2-11 12:28
ChatGPT不是万能的，给出的结果不一定时对的

gpt是作为助手提高工作效率的，对于连基本功都没有的人，让它写代码并不友好，因为分辨不了正误也无法修改