Word 图片操作

一. 一张一张的处理

</pre><pre name="code" class="vb">Sub 插入图片()
Dim myfile As FileDialog
Set myfile = Application.FileDialog(msoFileDialogFilePicker)
With myfile
.InitialFileName = "D:\"
If .Show = -1 Then
For Each fn In .SelectedItems
Set mypic = Selection.InlineShapes.AddPicture(FileName:=fn, SaveWithDocument:=True)
mypic.Width = 28.345 * 6.3 '根据需要设置
mypic.Height = 28.345 * 5.4
Next fn
End If
End With
Set myfile = Nothing
End Sub

二. 在表格中插入图片并根据单元格大小自动改变图片大小

Public Sub ResizeThePicture()
On Error Resume Next
Dim picW As Single, picH As Single
Dim cellW As Single, cellH As Single
Dim rtoW As Single, rtoH As Single
cellW = ActiveCell.Width
cellH = ActiveCell.Height
picW = Selection.ShapeRange.Width
picH = Selection.ShapeRange.Height
rtoW = cellW / picW * 0.95
rtoH = cellH / picH * 0.95
If rtoW < rtoH Then
Selection.ShapeRange.ScaleWidth rtoW, msoFalse, msoScaleFromTopLeft
Else
Selection.ShapeRange.ScaleHeight rtoH, msoFalse, msoScaleFromTopLeft
End If
picW = Selection.ShapeRange.Width
picH = Selection.ShapeRange.Height
Selection.ShapeRange.IncrementLeft (cellW - picW) / 2
Selection.ShapeRange.IncrementTop (cellH - picH) / 2
End Sub

三. 批量同时处理相同大小

Sub 图片大小处理()
Dim iSha As InlineShape
For Each iSha In ActiveDocument.InlineShapes
If iSha.Type = wdInlineShapePicture Then
iSha.LockAspectRatio = msoFalse
iSha.Width = CentimetersToPoints(4.6)
iSha.Height = CentimetersToPoints(4.2)
End If
Next
End Sub

四. 此法针对一个word文档表中有多种尺寸大小的图片

Sub 图片处理一()
Mywidth = 5.21 '5.21为图片宽度（厘米）
Myheigth = 3.92 '3.92为图片高度（厘米）
For Each iShape In ActiveDocument.InlineShapes
iShape.Height = 28.345 * Myheigth '1cm等于28.35px
iShape.Width = 28.345 * Mywidth '1cm等于28.35px
Next iShape
End Sub

Sub 图片大小处理二()
' 批量设置图片尺寸
' 设置好第一张整改图片（假设整改图片位于整个文档图片第k位）的大小之后,运行此宏即可.
Dim n
For n = k + 1 To ActiveDocument.InlineShapes.Count '注：k+1表示第二张整改图片，实际操作中要填入实际数值
ActiveDocument.InlineShapes(n).Width = ActiveDocument.InlineShapes(k).Width 'k表示第一张整改图片，实际操作中要填入实际数值
ActiveDocument.InlineShapes(n).Height = ActiveDocument.InlineShapes(k).Height 'k表示第一张整改图片，实际操作中要填入实际数值
Next n
End Sub