《利用excelVBA批量修改文件名以及自动插图到word》由会员分享，可在线阅读，更多相关《利用excelVBA批量修改文件名以及自动插图到word（3页珍藏版）》请在装配图网上搜索。
1、前段时间，因编写报告，需要把成果图片修改名字后，将图以及相应的名字插入word文档中。一次报告，至少200张图，花了数个小时才弄完工作，同时难免出现差错。之后就一直寻找捷径，基于excelvba以前有一点基础，现将整理出来的代码分享给大家。可以去下载我编好的excel小程序，里面有详细代码，地址在最下方。欢迎直接试用下，给个反馈建议.1. 查找文件夹中符合图片格式的文件，返回其名字Dimfs,f,f1,fc,sDimarrAsStringSetfs=CreateObject(Scripting.FileSystemObject)Address=ThisWorkbook.FullNameAddr
2、ess=Left(Address,InStrRev(Address,Len(Address)获得当前工作表所在文件夹路径Setf=fs.GetFolder(Address)Setfc=f.Filesi=2ForEachf1Infc遍历文件IfFileIspicture(f1.Name)Then引用了自定义函数FileIspicture判断是否为需要查找的文件格式phname=f1.Name获取文件名houzhui=Right(phname,Len(phname)-InStrRev(phname,.,Len(phname)+1)Sheet1.Cells(i,1)=Left(phname,InSt
3、rRev(phname,.,Len(phname)-1)Sheet1.Cells(i,2)=houzhuii=i+1EndIfNext2. 修改文件名称Subchangename()DimAddressAsStringAddress=ThisWorkbook.FullNameAddress=Left(Address,InStrRev(Address,Len(Address)n=Sheet1.Cells(Rows.Count,1).End(xlUp).rowFori=2Ton修改名称pname=Sheet1.Cells(i,1)&Sheet1.Cells(i,2)textname=Sheet1.
4、Cells(i,3)houzhui=Right(pname,Len(pname)-InStrRev(pname,.,Len(pname)+1)获取后缀NameAddress&pnameAsAddress&textname&houzhuiNextiMsgBox名称已改EndSub3.批量插图到wordDimappWDAsWord.ApplicationDimAddressAsStringmyName=picture.doc新建的word名称Address=ThisWorkbook.FullNameAddress=Left(Address,InStrRev(Address,Len(Address)
5、mydoc=Address&myNameOnErrorResumeNext错误处理Kill(mydoc)OnErrorGoTo0OnErrorResumeNextSetappWD=GetObject(,Word.Application)appWD.Documents.CloseSaveChanges:=wdDoNotSaveChangesappWD.QuitSetappWD=CreateObject(Word.Application)连接wordappWD.Documents.AddappWD.ActiveDocument.SaveAsfilename:=mydocappWD.Visible=
6、Truen=Sheet1.Cells(Rows.Count,1).End(xlUp).row获取工作表有效部分的最大行数Fori=2Ton插入图片pname=Sheet1.Cells(i,1)&Sheet1.Cells(i,2)textname=Sheet1.Cells(i,3)appWD.Selection.InlineShapes.AddPicturefilename:=Address&pname,LinkToFile:=False,SaveWithDocument:=TrueappWD.Selection.TypeParagraphappWD.Selection.TypeTextText
7、:=textnameappWD.Selection.TypeParagraphhouzhui=Right(pname,Len(pname)-InStrRev(pname,.,Len(pname)+1)Nexti居中，修改字体大小为10，字体加粗appWD.Selection.WholeStoryappWD.Selection.ParagraphFormat.Alignment=wdAlignParagraphCenterappWD.Selection.Font.Size=10appWD.Selection.Font.Name=宋体appWD.Selection.Font.Bold=wdTogg
8、le4.修改图片大小，使每页正好两张图DimpicwidthDimpicheightFori=1ToappWD.ActiveDocument.InlineShapes.CountInlineShapes类型图片H=appWD.ActiveDocument.InlineShapes(i).HeightW=appWD.ActiveDocument.InlineShapes(i).WidthHIV=W/HH=325W=HIV*HIfW=415ThenW=415H=W/HIVEndIfappWD.ActiveDocument.InlineShapes(i).Height=HappWD.ActiveDocument.InlineShapes(i).Width=WNextiPictureToWordCSDN下载地址这个需要1积分PictureToWordRaySource下载地址这个免费
利用excelVBA批量修改文件名以及自动插图到word
