1、前段时间，因编写报告，需要把成果图片修改名字后，将图以及相应的名字插入 word 文档中。一次报告，至少 200 张图，花了数个小时才弄完工作，同时难免出现差错。之后就一直寻找捷径，基于 excel vba 以前有一点基础，现将整理出来的代码分享给大家。可以去下载我编好的 excel 小程序，里面有详细代码，地址在最下方。欢迎直接试用下，给个反馈建议.1.查找文件夹中符合图片格式的文件，返回其名字Dim fs, f, f1, fc, sDim arr As StringSet fs = CreateObject(“Scripting.FileSystemObject“)Address = Th
2、isWorkbook.FullNameAddress = Left(Address, InStrRev(Address, “, Len(Address) 获得当前工作表所在文件夹路径Set f = fs.GetFolder(Address)Set fc = f.Filesi = 2For Each f1 In fc 遍历文件If FileIspicture(f1.Name) Then 引用了自定义函数 FileIspicture 判断是否为需要查找的文件格式 phname = f1.Name 获取文件名houzhui = Right(phname, Len(phname) - InStrRev
3、(phname, “.“, Len(phname) + 1)Sheet1.Cells(i, 1) = Left(phname, InStrRev(phname, “.“, Len(phname) - 1)Sheet1.Cells(i, 2) = houzhui i = i + 1End IfNext2.修改文件名称Sub changename()Dim Address As StringAddress = ThisWorkbook.FullNameAddress = Left(Address, InStrRev(Address, “, Len(Address)n = Sheet1.Cells(
4、Rows.Count, 1).End(xlUp).rowFor i = 2 To n 修改名称pname = Sheet1.Cells(i, 1) & Sheet1.Cells(i, 2)textname = Sheet1.Cells(i, 3)houzhui = Right(pname, Len(pname) - InStrRev(pname, “.“, Len(pname) + 1) 获取后缀Name Address & pname As Address & textname & houzhuiNext iMsgBox “名称已改 “End Sub3.批量插图到 wordDim appWD
5、 As Word.ApplicationDim Address As StringmyName = “picture.doc“ 新建的 word 名称Address = ThisWorkbook.FullNameAddress = Left(Address, InStrRev(Address, “, Len(Address)mydoc = Address & myNameOn Error Resume Next 错误处理Kill (mydoc)On Error GoTo 0On Error Resume NextSet appWD = GetObject(, “Word.Application
6、“)appWD.Documents.Close SaveChanges:=wdDoNotSaveChangesappWD.QuitSet appWD = CreateObject(“Word.Application“) 连接 wordappWD.Documents.AddappWD.ActiveDocument.SaveAs filename:=mydocappWD.Visible = Truen = Sheet1.Cells(Rows.Count, 1).End(xlUp).row 获取工作表有效部分的最大行数For i = 2 To n 插入图片pname = Sheet1.Cells(i
7、, 1) & Sheet1.Cells(i, 2)textname = Sheet1.Cells(i, 3)appWD.Selection.InlineShapes.AddPicture filename:=Address & pname, LinkToFile:= _False, SaveWithDocument:=TrueappWD.Selection.TypeParagraphappWD.Selection.TypeText Text:=textnameappWD.Selection.TypeParagraphhouzhui = Right(pname, Len(pname) - InS
8、trRev(pname, “.“, Len(pname) + 1)Next i居中，修改字体大小为 10，字体加粗appWD.Selection.WholeStoryappWD.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenterappWD.Selection.Font.Size = 10appWD.Selection.Font.Name = “宋体“appWD.Selection.Font.Bold = wdToggle4.修改图片大小，使每页正好两张图Dim picwidthDim picheightFor i = 1 T
9、o appWD.ActiveDocument.InlineShapes.Count InlineShapes 类型图片H = appWD.ActiveDocument.InlineShapes(i).HeightW = appWD.ActiveDocument.InlineShapes(i).WidthHIV = W / HH = 325W = HIV * HIf W = 415 ThenW = 415H = W / HIVEnd IfappWD.ActiveDocument.InlineShapes(i).Height = HappWD.ActiveDocument.InlineShapes(i).Width = WNext iPictureToWord CSDN 下载地址 这个需要 1 积分PictureToWord RaySource 下载地址 这个免费
