用excel给word插入照片，求大神

通信汪汪汪

只会简单的文本替换，想用EXCEL给word最后两页插入照片，并且设置环绕方式为衬于文字下发。


Sub auto_open()

   ActiveWorkbook.Worksheets("数据源").Select

End Sub


Sub 按钮2_Click()
Call CreatDoc
End Sub




Private Sub CreatDoc()


   Dim wordapp As New Word.Application, myPATH, myfilename, myfilefullpath, 数据名
   Dim i, j
   Dim Str1, Str2, Str3, picpath
   Dim xDoc     As Document
   Dim xShape     As InlineShape
   Dim fspic
   Dim myRange As Range
   Dim myWorkbook As Workbook


   Set myWorkbook = ActiveWorkbook
   myPATH = ThisWorkbook.Path
   mysheet = "数据源"
   TotalNum = Sheets(mysheet).Range("B65536").End(xlUp).Row
   判断 = 0

   For i = 2 To TotalNum

      myfilename = Sheets(mysheet).Range("A" & i) & "-" & "铁塔归档封面（" & Sheets(mysheet).Range("B" & i) & "）.doc"

      FileCopy myPATH & "\铁塔归档封面.doc", myPATH & "\" & myfilename

      myfilefullpath = myPATH & "\" & myfilename

      With wordapp
         .Documents.Open myfilefullpath
         .Visible = False



         '填写文字数据



         Str1 = "请勿修改2"
         Str2 = Sheets(mysheet).Cells(i, 3)
         .Selection.HomeKey Unit:=wdStory '光标置于文件首
         If .Selection.Find.Execute(Str1) Then '查找到指定字符串
            .Selection.Text = Str2 '替换字符串
            .Selection.Font.Color = wdColorAutomatic '字符为自动颜色

         End If


         Str1 = "请勿修改1"
         Str2 = Sheets(mysheet).Cells(i, 2)
         .Selection.HomeKey Unit:=wdStory '光标置于文件首
         If .Selection.Find.Execute(Str1) Then '查找到指定字符串
            .Selection.Text = Str2 '替换字符串
            .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
         End If

         Str1 = "书签3"
         Str2 = Sheets(mysheet).Cells(i, 4)
         .Selection.HomeKey Unit:=wdStory '光标置于文件首
         If .Selection.Find.Execute(Str1) Then '查找到指定字符串
            .Selection.Text = Str2 '替换字符串
            .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
         End If

         Str1 = "书签4"
         Str2 = Sheets(mysheet).Cells(i, 5)
         .Selection.HomeKey Unit:=wdStory '光标置于文件首
         If .Selection.Find.Execute(Str1) Then '查找到指定字符串
            .Selection.Text = Str2 '替换字符串
            .Selection.Font.Color = wdColorAutomatic '字符为自动颜色
         End If



      End With


      '保存文件
      wordapp.Documents.Save
      wordapp.Quit
      Set wordapp = Nothing

   Next i

   If 判断 = 0 Then
      j = MsgBox("已生成WORD文档", 0 + 48 + 256 + 0, "提示：")
   End If

End Sub

通信汪汪汪

求大哥围观

通信汪汪汪

。。。。。。。。。。。