求助各位大神！word图片插入问题！小弟万分感谢！

nicklybong

小弟想用excel的VBA将文件夹/案件照片/的“1”和“2”两张照片，自动调整照片长宽高，并插入word第一页中空白的地方。               “3”和“4”两张照片自动调整照片长宽高，并插入word第二页中空白的地方。                 小弟在此谢谢各位大神！已将附件上传！再次谢谢大神相助！！！！！

kqbt

为什么一定要到Excel里面去运行这个VBA？先弄个当前文档的VBA供参考吧：

1. Sub 批量插入图片并调整大小()
   
2.     Dim wdTabNum As Integer, n As Integer
   
3.     Dim wdPar As Paragraph, wdRng As Range
   
4.     Dim wdInPic As InlineShape
   
5.     For wdTabNum = 1 To 2
   
6.         n = 0
   
7.         Set wdRng = ThisDocument.Tables(wdTabNum).Range.Cells(1).Range
   
8.         With wdRng.Find
   
9.             .ClearFormatting
   
10.             .Replacement.ClearFormatting
    
11.             .Execute "^13{2,}", , , True, , , , , , "^p", wdReplaceAll
    
12.             If .Execute("执法人员：", , , False) Then
    
13.                 With .Parent
    
14.                     .Collapse (wdCollapseStart)
    
15.                     .InlineShapes.AddPicture ThisDocument.Path & "\案件照片" & wdTabNum + n & ".jpg"
    
16.                     .SetRange wdRng.End + 1, wdRng.End + 1
    
17.                     .InsertBefore vbCrLf & vbCrLf
    
18.                     .Collapse (wdCollapseEnd)
    
19.                     n = n + 1
    
20.                     .InlineShapes.AddPicture ThisDocument.Path & "\案件照片" & wdTabNum + n & ".jpg"
    
21.                     .SetRange wdRng.End + 1, wdRng.End + 1
    
22.                     .InsertAfter vbCrLf & vbCrLf & vbCrLf
    
23.                 End With
    
24.             End If
    
25.         End With
    
26.     Next
    
27.     For Each wdInPic In ThisDocument.InlineShapes
    
28.         wdInPic.Height = wdInPic.Height * (14 / PointsToCentimeters(wdInPic.Width))
    
29.         wdInPic.Width = CentimetersToPoints(14)
    
30.     Next
    
31.     MsgBox "处理完成！"
    
32. End Sub

复制代码

相关证据粘贴页照片.rar (13.4 KB, 下载次数: 20)

2016-10-25 13:39 上传

点击文件名下载附件

liuym

下载学习学习了，