还是谢谢

wdpfox

谢谢楼下各位老师。

约定的童话

Sub VBA提取Word里面图片()
    Dim i As Integer, Str As String, Path As String
    Dim Word, Myword As Object
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Path = ThisWorkbook.Path & "\"
    Str = Dir(Path & "*.docx")
    Set Word = VBA.CreateObject("word.application")
    Do While Str <> ""
        If Not (Str = "提取Word图片.xlsm") Then
            Set Myword = Word.Documents.Open(Path & Str)
            Word.Visible = True
            Myword.InlineShapes(2).Select
            Word.Selection.Copy
            i = i + 1
            ActiveSheet.Cells(i, 1) = Split(Str, ".")(0)
            ActiveSheet.Cells(i, 2).Activate
            ActiveSheet.PasteSpecial Format:="图片(增强型图元文件)", Link:=False, DisplayAsIcon:=False
            Myword.Close True
        End If
    Loop
    Word.Close
    MsgBox "提取完毕！", , "报告！"
End Sub

zhanglei1371

方案1，复制后剪贴板中提取，可以翻我以前发过的代码；
方案2，创建Excel对象，使用chartobject对象另存，论坛很多例子；
方案3，利用.netcom方法；
方案4，ado的Strean对象转化为字节再保存为图像。
至于word自带的，只能手动，VBa没法调用。

wdpfox

谢谢两位老师

perfect131

word自带也可以 ，只不过你要结合vbs
Sub kong()
    ActiveDocument.InlineShapes(1).Select
    ''''另存窗口
    CommandBars.FindControl(ID:=5736).Execute
    ''''用vbs填写另存位置
End Sub

wdpfox

perfect131 发表于 2022-6-30 11:31
word自带也可以 ，只不过你要结合vbs
Sub kong()
    ActiveDocument.InlineShapes(1).Select

谢谢，程序可行简便，老师能否赐教自定义路径代码，选择路径毕竟有点烦！

perfect131

wdpfox 发表于 2022-6-30 13:26
谢谢，程序可行简便，老师能否赐教自定义路径代码，选择路径毕竟有点烦！

参考：https://club.excelhome.net/thread-1618542-1-1.html
7楼 CompleteUploadThread

wdpfox

perfect131 发表于 2022-6-30 17:10
参考：https://club.excelhome.net/thread-1618542-1-1.html
7楼 CompleteUploadThread

谢谢老师，学习了一下，由于是门外汉，不会改写，烦请老师拨冗赐代码吧，谢谢！