word中根据路径自动插入图片

ww0000

闻启学 发表于 2014-8-13 17:14
请测试

'//   Debug.Print myTable.Range.Cells.Count
'//    Debug.Print mypic
'//D:\TDDOWNLOAD\插入图片(1)\IMG

这些是什么用的？前面带单引号，好象没用吧？

闻启学

xyc0321 发表于 2014-8-13 21:21
谢谢回复，你做的这个是在单元格里的，我要求的是用图片替换掉原来文档里的图片途径文字，请看帖子里的两 ...

你的完成的 3楼的代码就是啊

闻启学

ww0000 发表于 2014-8-13 21:30
'//   Debug.Print myTable.Range.Cells.Count
'//    Debug.Print mypic
'//D:\TDDOWNLOAD\插入图片(1 ...

这个是测试使用   已经注释 了

pipiludaxian

将闻兄代码略做修改了。
保证运行的条件有二：
1、请将word文档中的图片名与文件夹中图片名保持高度一致。
2、将图片和word文档放在同一文件夹内。

经测试，成功！
Sub insertpic() '插入图片
    Dim mypic As String
    On Error Resume Next
    For i = 1 To ActiveDocument.Paragraphs.Count
        mypic = Trim(ActiveDocument.Paragraphs(i).Range.Text)
        If InStr(mypic, "png") > 0 Then
            mypic = ActiveDocument.Path & "\" & Left(mypic, Len(mypic) - 1)
            ActiveDocument.Paragraphs(i).Range.Select
            Selection.InlineShapes.AddPicture fileName:=mypic, LinkToFile:=False, SaveWithDocument:=True
            Selection.InsertBefore (Chr(10))
        End If
    Next
End Sub

ww0000

闻启学 发表于 2014-8-13 22:51
这个是测试使用   已经注释 了

加On Error Resume Next可以用了,
不加On Error Resume Next出现

xyc0321

pipiludaxian 发表于 2014-8-14 00:57
将闻兄代码略做修改了。
保证运行的条件有二：
1、请将word文档中的图片名与文件夹中图片名保持高度一致。 ...

非常感谢，测试成功！

闻启学

ww0000 发表于 2014-8-14 08:07
加On Error Resume Next可以用了,
不加On Error Resume Next出现

这个是你的文件名称无效啊

ww0000

闻启学 发表于 2014-8-14 09:07
这个是你的文件名称无效啊

加On Error Resume Next可以用就行了,谢谢!
另外,“\img\图片3.png”这个改成“图片3”，不带路径，代码要怎么改？？

pipiludaxian

Sub insertpic() 'by pipilu
'以下为在表格中插入图片方法
'1 保证word文档与图片在一个文件夹内
'2 Print 使word中图片名与文档中图片名高度一致(包括后缀)
'图片命名不支持\等符号，因此建议用其他符号做word中图片名的标识符。
'如word中其他处无png字样，即png只用于图片名处，可用   图片1.png   样式
Dim tb As Table
Dim rw As Row
On Error Resume Next
For Each tb In ActiveDocument.Tables
    For Each rw In tb.Rows
        If InStr(rw.Cells(1).Range.Text, "png") > 0 Then
           txt = Trim(rw.Cells(1).Range.Text)
           pth = ActiveDocument.Path & "\" & Left(txt, Len(txt) - 2)
            rw.Cells(2).Range.InlineShapes.AddPicture fileName:=pth, LinkToFile:=False, SaveWithDocument:=True
        End If
    Next rw
Next tb
End Sub

闻启学

ww0000 发表于 2014-8-14 09:25
加On Error Resume Next可以用就行了,谢谢!
另外,“\img\图片3.png”这个改成“图片3”，不带路径，代码 ...

这样的话  运行很慢

要每一个句都要判断是否有这个文件名称