自动插入图片

在WORD文档中输入图片名称，就可以自动插入该图片，并且删除文档中录入的名称（图片固定存放在目录D:\P\ 下，所有图片均为　JPG格式）

例如：　在文档中输入　DZ01-001则文字被替换成　DZ01-001.JPG的图片。

请问该用什么方法呢？我现在的图有2万多个要能这样打编号就出来

解决的方法，我没想，至少有3~4种，但是20000多个，假如一个JPG是20K的话，已是400M了，可能吗？WORD的极限才35M吧。

你先告诉我，你想达到的目的和实际JPG的大小。

我想用的是套打方式，每次插入不等数量的图（图库现在总共有20000个图左右，名称都有规律的，如DZ******.JPG）打印，然后手工清除，我不想每次都用　插入--图片--来自文件，请问能有办法吗？

大哥，如果你想解决问题，上传一下你的文档总是可以的吧？

你以为很容易解决吗？

我必须知道你在文档中，是如何输入编号的，这很重要。

l3VdlSAg.rar (8.87 KB) 　　请看附件。

请参考：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋'* Created By I Love You_Word!@ExcelHome 2005-10-27 5:00:57'仅测试于System: Windows NT Word: 10.0 Language: 2052'№ 00068^The Code CopyIn [ThisDocument-ThisDocument]^''* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－Option ExplicitSub InsertJGP()Dim myPictureFolder As String, aPar As Paragraph, KeyPostion As LongDim PictureName As String, myRange As RangeOn Error Resume Next'忽略错误Application.ScreenUpdating = False'关闭屏幕更新,加快运行速度myPictureFolder = "D:\P\"'定义一个文件夹位置With ActiveDocument'针对活动文档For Each aPar In .Paragraphs'遍历段落If VBA.InStr(aPar.Range, "货品图片") = 1 Then'如果段落以"货品图片"开头KeyPostion = VBA.InStr(aPar.Range, "：")'并且在段落中找到"："Set myRange = .Range(aPar.Range.Start + KeyPostion, aPar.Range.End - 1)'取得文件名所对应的RANGE对象PictureName = VBA.Trim(myRange)'去除空格myRange.Delete'删除该RANGE内容'Debug.Print PictureName'如果在指定位置中找到该文件If Dir(myPictureFolder & PictureName, vbDirectory) <> "" Then'添加一个嵌入式图形.InlineShapes.AddPicture myPictureFolder & PictureName, , , myRangeEnd IfEnd IfNextEnd WithApplication.ScreenUpdating = True'恢复屏幕更新End Sub'----------------------Sub InsertJPG2()Dim myPictureFolder As String, aPar As Paragraph, KeyPostion As Long, myRange As RangeOn Error Resume Next'忽略错误Application.ScreenUpdating = False'关闭屏幕更新,加快运行速度myPictureFolder = "D:\\P\\"'定义一个文件夹位置With ActiveDocument'针对活动文档For Each aPar In .Paragraphs'遍历段落If VBA.InStr(aPar.Range, "货品图片") = 1 Then'如果段落以"货品图片"开头KeyPostion = VBA.InStr(aPar.Range, "：")'并且在段落中找到"："Set myRange = .Range(aPar.Range.Start + KeyPostion, aPar.Range.End - 1)'取得文件名所对应的RANGE对象myRange = "INCLUDEPICTURE""" & myPictureFolder & myRange & """" '插入图片域.Fields.Add myRange, wdFieldEmpty, , FalsemyRange.Fields(1).Update '逐域更新End IfNextEnd WithApplication.ScreenUpdating = True'恢复屏幕更新End Sub'----------------------

谢谢版主，搞定了

[em17]

很牛，留个脚印，下次好好拜读大师的作品