word宏自动插图片并带上名字

《word宏自动插图片并带上名字》由会员上传分享，免费在线阅读，更多相关内容在行业资料-天天文库。

1、插入图片自动放在表格中并获取图片的名字（宏VBA代码）如下格式：风景-01风景-02风景-03风景-04风景-05风景-06………1实现上述格式的宏代码程序如下：Sub每行插入表格n个图()OnErrorResumeNextApplication.ScreenUpdating=FalseDimDAsFileDialog,a,PAsInlineShape,tAsTableIfSelection.Information(wdWithInTable)=TrueThenMsgBox"请将光标置于表格之外！":ExitSubWithApplication.Fi

2、leDialog(msoFileDialogFilePicker).Title="请选择..."If.Show=-1Thenn=InputBox("请输入表格的列数：","列数",3)M=.SelectedItems.CountDebug.Print"共有"&M&"个图片";Mh=IIf(M/n=Int(M/n),2*M/n,2*(Int(M/n)+1))Sett=ActiveDocument.Tables.Add(Selection.Range,h,n)t.Borders.Enable=Truet.Borders.OutsideLineStyle=

3、wdLineStyleSingle'设置表格的外边框的类型ForEachaIn.SelectedItemsB=Split(a,"")(UBound(Split(a,"")))C=Split(B,".")(0)SetP=Selection.InlineShapes.AddPicture(FileName:=a,SaveWithDocument:=True)WithP'设置图片的大小w=.Width.Width=Int(410/n).Height=.Width*.Height/wEndWith'设置图片大小结束i=i+1Selection.MoveL

4、eftwdCharacter,1Selection.MoveDownwdLine,1Selection.TypeTextCSelection.Cells(1).SelectSelection.ParagraphFormat.Alignment=wdAlignParagraphCenter'决定了首行居中Selection.HomeKeySelection.MoveDownwdLine,-1Selection.MoveRightwdCharacter,2Debug.Printi,nIfi=Val(n)ThenSelection.MoveRightwdC

5、haracter,1Selection.Cells(1).SelectSelection.EndKeySelection.MoveDownwdLine,1i=0EndIf2NextEndIfEndWithApplication.ScreenUpdating=TrueEndSub3如下格式：风景-16风景-014实现上述格式的宏代码程序如下：Sub简单无表格式1列插图()DimmyfileAsFileDialogSetmyfile=Application.FileDialog(msoFileDialogFilePicker)Withmyfile.Ini

6、tialFileName="F:"If.Show=-1ThenForEachfnIn.SelectedItemsSetmypic=Selection.InlineShapes.AddPicture(FileName:=fn,SaveWithDocument:=True)'按比例调整相片尺寸WidthNum=mypic.Widthc=10'在此处修改相片宽,单位厘米mypic.Width=c*28.35mypic.Height=(c*28.35/WidthNum)*mypic.HeightIfSelection.Start=ActiveDocumen

7、t.Content.End-1Then'如光标在文末Selection.TypeParagraph'在文末添加一空段ElseSelection.MoveDownEndIfSelection.Text=Basename(fn)'函数取得文件名Selection.EndKeyIfSelection.Start=ActiveDocument.Content.End-1Then'如光标在文末Selection.TypeParagraph'在文末添加一空段ElseSelection.MoveDownEndIfNextfnElseEndIfEndWithSetm

8、yfile=NothingEndSubFunctionBasename(FullPath)'取得文件名Dim