VBA批量导入图片到多Word文档并加标题（会飞的鱼）

感谢会飞的鱼大牛~

 Public fp$, obmapp As Object
 Sub kk()
 文件夹浏览器
 Application.ScreenUpdating = False
 Set fso = CreateObject("scripting.filesystemobject")
 If fp = "" Then Exit Sub
 Set ff = fso.getfolder(fp)
 For x =  To
     Documents.Add DocumentType:=wdNewBlankDocument
     For Each fd In ff.subfolders
         t = Int(fd.Files.Count / )
         For y =  To t
             Selection.InlineShapes.AddPicture FileName:=fd & "\" & x * t - t + y & ".png", LinkToFile:=False, SaveWithDocument:=True
             Selection.TypeParagraph
             Selection.TypeText Text:=fd.Name & "_" & Format(x * t - t + y, "") & Chr()
         Next
     Next
     Selection.WholeStory
     Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

     '替换名称中的+为/
     Selection.Find.ClearFormatting
     Selection.Find.Replacement.ClearFormatting
     With Selection.Find
         .Text = "+"
         .Replacement.Text = "/"
         .Forward = True
         .Wrap = wdFindContinue
         .Format = False
         .MatchCase = False
         .MatchWholeWord = False
         .MatchByte = True
         .MatchWildcards = False
         .MatchSoundsLike = False
         .MatchAllWordForms = False
     End With
     Selection.Find.Execute Replace:=wdReplaceAll
     '上面是录制的宏
     ActiveDocument.SaveAs2 FileName:=fp & "\" & x & ".docx"
     ActiveWindow.Close
 Next
 Application.ScreenUpdating = True
 End Sub
 Sub 文件夹浏览器()
     Set obmapp = CreateObject("Shell.Application").BrowseForFolder(, "请选择文件目录：", , )
     If Not obmapp Is Nothing Then
         fp = obmapp.Self.Path & ""
     Else
         Exit Sub
     End If
 End Sub