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

1插入图片自动放在表格中并获取图片的名字（宏VBA代码）如下格式：风景-01风景-02风景-03风景-04风景-05风景-06………2实现上述格式的宏代码程序如下：Sub每行插入表格n个图()OnErrorResumeNextApplication.ScreenUpdating=FalseDimDAsFileDialog,a,PAsInlineShape,tAsTableIfSelection.Information(wdWithInTable)=TrueThenMsgBox请将光标置于表格之外！:ExitSubWithApplication.FileDialog(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=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.MoveLeftwdCharacter,1Selection.MoveDownwdLine,1Selection.TypeTextCSelection.Cells(1).SelectSelection.ParagraphFormat.Alignment=wdAlignParagraphCenter'决定了首行居中Selection.HomeKeySelection.MoveDownwdLine,-1Selection.MoveRightwdCharacter,2Debug.Printi,nIfi=Val(n)ThenSelection.MoveRightwdCharacter,1Selection.Cells(1).SelectSelection.EndKeySelection.MoveDownwdLine,1i=0EndIf3NextEndIfEndWithApplication.ScreenUpdating=TrueEndSub4如下格式：风景-16风景-015实现上述格式的宏代码程序如下：Sub简单无表格式1列插图()DimmyfileAsFileDialogSetmyfile=Application.FileDialog(msoFileDialogFilePicker)Withmyfile.InitialFileName=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=ActiveDocument.Content.End-1Then'如光标在文末Selection.TypeParagraph'在文末添加一空段ElseSelection.MoveDownEndIfSelection.Text=Basename(fn)'函数取得文件名Selection.EndKeyIfSelection.Start=ActiveDocument.Content.End-1Then'如光标在文末Selection.TypeParagraph'在文末添加一空段ElseSelection.MoveDownEndIfNextfnElseEndIfEndWithSetmyfile=NothingEndSubFunctionBasename(FullPath)'取得文件名Dimx,yDimtmpstringtmpstring=FullPathx=Len(FullPath)Fory=xTo1Step-1IfMid(FullPath,y,1)=\Or_Mid(FullPath,y,1)=:Or_Mid(FullPath,y,1)=/Thentmpstring=Mid(FullPath,y+1)6ExitForEndIfNextBasename=Left(tmpstring,Len(tmpstring)-4)EndFunction