请教，word插入图片问题。

qq_40952908 2017-11-08 03:34:11
请教，word插入图片问题。
在同一个目录下，有十至30左右的DOC文件和相等数量的JPG文件，文件名相同，如：张三.doc和张三.jpg
要把图片插入到doc文件中。

指定文件名时，没有出错，但使用变量时，就过不去。

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")
Dim objWdRange As Word.Range
Dim GraphImage As String
GraphImage = "c:\456\timg.jpg"
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open("c:\456\timg.doc")

Selection.MoveDown Unit:=wdLine, Count:=2


With wrdDoc
Dim wrdPic As Word.InlineShape
Set wrdPic = .Range.InlineShapes.AddPicture(FileName:=GraphImage, LinkToFile:=False, SaveWithDocument:=True)
wrdPic.ScaleHeight = 50
wrdPic.ScaleWidth = 50
ActiveDocument.Save
End With
wrdDoc.Close
Set wrdDoc = Nothing
wrdApp.Quit
Set wrdApp = Nothing

这个是指定文件名的 可以通过

'文件名分类
Dim a() As String
Dim doc() As String
Dim jpg() As String

Dim i As Integer
Dim j As Integer

Dim fn As String


Dim fso As Object
Dim folder As Object
Dim subfolder As Object
Dim file As Object
Set fso = CreateObject("scripting.filesystemobject") '??FSO??
Set folder = fso.getfolder("c:\456")
TextBox2.Text = ""
For Each file In folder.Files '??????????
' MsgBox file '?????

If TextBox2.Text = "" Then
TextBox2.Text = file & ","
Else




TextBox2.Text = TextBox2.Text & vbCrLf & file & ","
' TextBox1.TextBox = file
'?????
End If
Next
Set fso = Nothing
Set folder = Nothing

a = Split(TextBox2.Text, ",") '??????
doc = Split(TextBox2.Text, ",")
jpg = Split(TextBox2.Text, ",")




For i = 0 To UBound(doc) '????.doc ??????
If doc(i) <> "" Then
If Right(doc(i), 4) <> ".doc" Then
doc(i) = ""
End If

If Left(doc(i), 1) = "~$" Then
doc(i) = ""
End If
End If

Next


For i = 0 To UBound(doc) '????.jpg ??????
If jpg(i) <> "" Then
If Right(jpg(i), 4) <> ".jpg" Then
jpg(i) = ""
End If
End If

Next


TextBox2.Text = ""

For i = 0 To UBound(doc) '??doc

If doc(i) <> "" Then

If TextBox2.Text = "" Then
TextBox2.Text = doc(i)
Else
TextBox2.Text = TextBox2.Text & vbCrLf & doc(i)
End If

End If

Next

TextBox3.Text = ""

For i = 0 To UBound(jpg) '??jpg

If jpg(i) <> "" Then

If TextBox3.Text = "" Then
TextBox3.Text = jpg(i)
Else
TextBox3.Text = TextBox3.Text & vbCrLf & jpg(i)
End If

End If


Next


'分类完成


'插图


'-----------------------------------------------------


For i = 0 To UBound(doc)
If doc(i) <> "" Then
j = 0

j = i + 1





Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")
Dim objWdRange As Word.Range
Dim GraphImage As String
GraphImage = jpg(j)
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open(doc(i))




With wrdDoc
Dim wrdPic As Word.InlineShape
Set wrdPic = .Range.InlineShapes.AddPicture(FileName:=GraphImage, LinkToFile:=False, SaveWithDocument:=True)
wrdPic.ScaleHeight = 50
wrdPic.ScaleWidth = 50
ActiveDocument.Save
End With
wrdDoc.Close
Set wrdDoc = Nothing
wrdApp.Quit
Set wrdApp = Nothing




Label1.Caption = "完成"






' Selection.InlineShapes(1).Height = 76.55
' Selection.InlineShapes(1).Width = 62.35

' Selection.Cut
' Selection.MoveDown Unit:=wdLine, Count:=2
' Selection.PasteAndFormat (wdPasteDefault)
' ActiveDocument.Save
' ActiveDocument.Close
End If

Next


这是变量名为文件名，在插入图片时，总是报错。
请大神帮我看看，万分感谢

...全文
581 2 打赏 收藏 转发到动态 举报
写回复
用AI写文章
2 条回复
切换为时间正序
请发表友善的回复…
发表回复
qq_40952908 2017-11-08
  • 打赏
  • 举报
 回复
还是不行呀
赵4老师 2017-11-08
  • 打赏
  • 举报
 回复 
  Dim wrdApp As Word.Application
  Dim wrdDoc As Word.Document
  Set wrdApp = CreateObject("Word.Application")
  Dim objWdRange As Word.Range
  Dim GraphImage As String
  GraphImage = "c:\456\timg.jpg"
  wrdApp.Visible = True
  Set wrdDoc = wrdApp.Documents.Open("c:\456\timg.doc")
  Selection.MoveDown Unit:=wdLine, Count:=2
  With wrdDoc
    Dim wrdPic As Word.InlineShape
    Set wrdPic = .Range.InlineShapes.AddPicture(FileName:=GraphImage, LinkToFile:=False, SaveWithDocument:=True)
    wrdPic.ScaleHeight = 50
    wrdPic.ScaleWidth = 50
    ActiveDocument.Save
  End With
  wrdDoc.Close
  Set wrdDoc = Nothing
  wrdApp.Quit
  Set wrdApp = Nothing
'这个是指定文件名的 可以通过


'文件名分类
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim objWdRange As Word.Range
Dim GraphImage As String
Dim wrdPic As Word.InlineShape
Dim a() As String
Dim doc() As String
Dim jpg() As String
Dim i As Integer
Dim j As Integer
Dim fn As String
Dim fso As Object
Dim folder As Object
Dim subfolder As Object
Dim file As Object
Set fso = CreateObject("scripting.filesystemobject")                          '??FSO??
Set folder = fso.getfolder("c:\456")
TextBox2.Text = ""
For Each file In folder.Files                     '??????????
           '   MsgBox file     '?????
              If TextBox2.Text = "" Then
              TextBox2.Text = file & ","
              Else
              TextBox2.Text = TextBox2.Text & vbCrLf & file & ","
           '  TextBox1.TextBox = file
              '?????
               End If
Next
Set fso = Nothing
Set folder = Nothing
a = Split(TextBox2.Text, ",")                    '??????
doc = Split(TextBox2.Text, ",")
jpg = Split(TextBox2.Text, ",")
For i = 0 To UBound(doc)     '????.doc ??????
  If doc(i) <> "" Then
    If Right(doc(i), 4) <> ".doc" Then
      doc(i) = ""
    End If
    If Left(doc(i), 1) = "~$" Then
          doc(i) = ""
       End If
  End If
Next
For i = 0 To UBound(doc)     '????.jpg ??????
  If jpg(i) <> "" Then
    If Right(jpg(i), 4) <> ".jpg" Then
      jpg(i) = ""
    End If
  End If
Next
TextBox2.Text = ""
For i = 0 To UBound(doc)     '??doc
    If doc(i) <> "" Then
       If TextBox2.Text = "" Then
          TextBox2.Text = doc(i)
       Else
          TextBox2.Text = TextBox2.Text & vbCrLf & doc(i)
       End If
    End If
 Next
TextBox3.Text = ""
For i = 0 To UBound(jpg)     '??jpg
    If jpg(i) <> "" Then
       If TextBox3.Text = "" Then
          TextBox3.Text = jpg(i)
       Else
          TextBox3.Text = TextBox3.Text & vbCrLf & jpg(i)
       End If
    End If
Next
'分类完成
'插图
'-----------------------------------------------------
For i = 0 To UBound(doc)
    If doc(i) <> "" Then
        'j = 0
        j = i + 1
        Set wrdApp = CreateObject("Word.Application")
        GraphImage = jpg(j)
        Debug.Print "jpg(j:"+CStr(j)+"):["+jpg(j)+"]" '★加这句在立即窗口显示jpg(j)的值辅助调试错误：比如为""或前面少c:\456\ ?
        wrdApp.Visible = True
        Set wrdDoc = wrdApp.Documents.Open(doc(i))
        With wrdDoc
          Set wrdPic = .Range.InlineShapes.AddPicture(FileName:=GraphImage, LinkToFile:=False, SaveWithDocument:=True)
          wrdPic.ScaleHeight = 50
          wrdPic.ScaleWidth = 50
          ActiveDocument.Save
        End With
        wrdDoc.Close
        Set wrdDoc = Nothing
        wrdApp.Quit
        Set wrdApp = Nothing
        Label1.Caption = "完成"
         '   Selection.InlineShapes(1).Height = 76.55
       '   Selection.InlineShapes(1).Width = 62.35
        '   Selection.Cut
        '  Selection.MoveDown Unit:=wdLine, Count:=2
       '   Selection.PasteAndFormat (wdPasteDefault)
       '  ActiveDocument.Save
'         ActiveDocument.Close
    End If
Next
ThinkPHP5生成二维码及背景图片合成
二维码是我们在开发网站和项目的时候经常遇到的，我第一次接触二维码时，翻过许多资料，也请教许多所谓高人，被整的还是一头雾水，于是自己下决心一定搞明白二维码到底怎么回事，在经历许多坑，花费许多时间和精力后...
UEditor粘贴word图片问题解决
接下来是怎么拿到本地地址的文件，怎么将本地地址搞成文件，我查阅了好久好久的资料，还请教了各路大神（骚骚的三水，和传说中的周皇），得到一个结论，单纯前端不可能通过本地地址拿到文件（这估计就是ueditor为什么不能粘贴word图片的根本原因），因为我们的页面也在内嵌到客户端内与客户端有数据交流，因此就委托我们的客户端大佬帮我抓到了文件对象。但是尝试在罪魁祸首那行代码前将地址强制替换成网络地址就会发现，所替换的地址就会正常显示，因此找到了解决方案，就是将富文本中的img标签的src想办法替换成网络地址，
word图文混排复制到TinyMCE图片不显示
ueditor粘贴不能粘贴word中的图片是一个很头疼的问题，在我们的业务场景中客户要求必须使用ueditor并且支持word的图片粘贴，因为这个需求头疼了半个月，因为前端方面因为安全的原因是不允许访问本地文件的。接下来是怎么拿到本地地址的文件，怎么将本地地址搞成文件，我查阅了好久好久的资料，还请教了各路大神（骚骚的三水，和传说中的周皇），得到一个结论，单纯前端不可能通过本地地址拿到文件（于是第一条解决思路出来了，在执行 罪魁祸首代码 之前，将本地的地址过滤出来，上传到服务器然后用服务器的地址进行替换，
在线编辑器粘贴word图片且图片文件自动上传功能
ueditor粘贴不能粘贴word中的图片是一个很头疼的问题，在我们的业务场景中客户要求必须使用ueditor并且支持word的图片粘贴，因为这个需求头疼了半个月，因为前端方面因为安全的原因是不允许访问本地文件的。接下来是怎么拿到本地地址的文件，怎么将本地地址搞成文件，我查阅了好久好久的资料，还请教了各路大神（骚骚的三水，和传说中的周皇），得到一个结论，单纯前端不可能通过本地地址拿到文件（于是第一条解决思路出来了，在执行 罪魁祸首代码 之前，将本地的地址过滤出来，上传到服务器然后用服务器的地址进行替换，
umeditor粘贴word图片且图片文件自动上传功能
ueditor粘贴不能粘贴word中的图片是一个很头疼的问题，在我们的业务场景中客户要求必须使用ueditor并且支持word的图片粘贴，因为这个需求头疼了半个月，因为前端方面因为安全的原因是不允许访问本地文件的。接下来是怎么拿到本地地址的文件，怎么将本地地址搞成文件，我查阅了好久好久的资料，还请教了各路大神（骚骚的三水，和传说中的周皇），得到一个结论，单纯前端不可能通过本地地址拿到文件（于是第一条解决思路出来了，在执行 罪魁祸首代码 之前，将本地的地址过滤出来，上传到服务器然后用服务器的地址进行替换，
Office开发/ VBA

5,139

社区成员

17,886

社区内容

发帖
与我相关
我的任务
社区描述
其他开发语言 Office开发/ VBA
社区管理员
  • Office开发/ VBA社区
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章