利用excel VBA批量修改文件名以及自动插图到word.doc

前段时间，因编写报告，需要把成果图片修改名字后，将图以及相应的名字插入word文档中。一次报告，至少200张图，花了数个小时才弄完工作，同时难免出现差错。之后就一直寻找捷径，基于excel vba以前有一点基础，现将整理出来的代码分享给大家。可以去下载我编好的excel 小程序，里面有详细代码，地址在最下方。欢迎直接试用下，给个反馈建议.1.查找文件夹中符合图片格式的文件，返回其名字Dim fs, f, f1, fc, sDim arr As StringSet fs = CreateObject(Scripting.FileSystemObject)Address = ThisWorkbook.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(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(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 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)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, 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) - InStrRev(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 To 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.Inl