Sub tongyixiugaichicun()
  Dim oInlineShape As InlineShape
     For Each oInlineShape In ActiveDocument.InlineShapes
         With oInlineShape
             .LockAspectRatio = msoFalse    '不锁定纵横比
           ' .ScaleHeight = 10
           .Width = CentimetersToPoints(8)
           .Height = CentimetersToPoints(6)
          '  .ScaleWidth = 10
         End With
     Next
 End Sub
  

'版心尺寸大小（假设 Word 2003 中，A4纵向纸张，宽度已知是21厘米，左边距2.5厘米，右边距2.5厘米，所以，版心尺寸=宽度-左边距-右边距=16厘米）
    Dim Width As Single, Left As Single, Right As Single
    Width = Round(ActiveDocument.PageSetup.PageWidth / 28.35)
    Left = Round(ActiveDocument.PageSetup.LeftMargin / 28.35, 1)
    Right = Round(ActiveDocument.PageSetup.RightMargin / 28.35, 1)
    MsgBox "版心尺寸是 " & (Width - Left - Right) & " 厘米"


Sub 图片宽度批量调整()
Dim i
Dim j
Dim oldHeight
Dim oldWidth
Dim newHeight
Dim newWidth
Dim docWidth
docWidth = 15 * 28.345

On Error Resume Next
For i = 1 To ActiveDocument.InlineShapes.Count
 oldWidth = ActiveDocument.InlineShapes(i).Width
 oldHeight = ActiveDocument.InlineShapes(i).Height
 '如果长度大于内容区的长度则自动修改图片长度为内容区，图片高度按照比例压缩
 If oldWidth > docWidth Then
     newWidth = docWidth
     newHeight = newWidth * oldHeight / oldWidth
 End If
 ActiveDocument.InlineShapes(i).Height = newHeight '修改为自己需要的值
 ActiveDocument.InlineShapes(i).Width = newWidth '修改为自己需要的值

Next
For j = 1 To ActiveDocument.Shapes.Count
  oldWidth = ActiveDocument.InlineShapes(i).Width
  oldHeight = ActiveDocument.InlineShapes(i).Height
 '如果长度大于内容区的长度则自动修改图片长度为内容区，图片高度按照比例压缩
 If oldWidth > docWidth Then
     newWidth = docWidth
     newHeight = newWidth * oldHeight / oldWidth
 End If
 ActiveDocument.InlineShapes(j).Height = newHeight '修改为自己需要的值
 ActiveDocument.InlineShapes(j).Width = newWidth '修改为自己需要的值

Next

End Sub

在word里保存比较大的图片，都大得超出了word的边界了，也没有居中，数量又多，不可能手动一张张调整。
 
第一种方法经过测试，只是前面部分有效，后面部分无效。
 
Sub setpicsize() '设置图片尺寸

'第一种方法，经测试，文档前面部分图片有效，后面部分无效
    'Dim n '图片个数
    'On Error Resume Next '忽略错误
    'For n = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes 类型 图片
    'ActiveDocument.InlineShapes(n).Height = 198.45 '设置图片高度为 7cm
    'ActiveDocument.InlineShapes(n).Width = 455 '单位是像素，设置图片宽度 16cm
    'Next n
End Sub
 
 第二种方法，经测试，对整篇文档图片有效：
 
Sub 设置图片格式()
    '1.如果图片行间距设置为固定值，那么无论图片设置什么格式，图片嵌入文字会重叠，只显示部分图片。
    '2.如果图片超出边界才进行处理，设置全文图片大小不超过某个规格，超过则等比例缩小
    Dim picMaxWidth, picMaxHeight, picWith, picHeight As Long
    '纸张宽减去左右边距，不用再乘以28.35，已经是像素
    picMaxWidth = (ActiveDocument.PageSetup.PageWidth - ActiveDocument.PageSetup.LeftMargin - ActiveDocument.PageSetup.RightMargin)
    picMaxHeight = (ActiveDocument.PageSetup.PageHeight - ActiveDocument.PageSetup.TopMargin - ActiveDocument.PageSetup.BottomMargin)
    Dim oILS As InlineShape
    For Each oILS In ActiveDocument.InlineShapes 'Selection.InlineShapes
        If oILS.Type = wdInlineShapePicture Then
        oILS.Select
            oILS.LockAspectRatio = msoTrue '锁定纵横比，防止默认没有锁定修改了图片变形；不锁定纵横比是msoFalse
            Selection.Range.ShapeRange.LockAspectRatio = msoTrue
            'MsgBox("图片宽度" & oILS.Width) '测试，提示图片大小以便判断单位'此处单位是像素。
            picWidth = oILS.Width
            picHeight = oILS.Height
            If oILS.Width > picMaxWidth Then
                'Word中的尺寸单位默认是cm（厘米），而1cm等于28.35px（像素），由于代码中换算设置的单位是px（像素）。
                '所以就用尺寸高度或宽度值乘像素值。即为：7*28.35=198.45；宽度换算方法与此相同。
                oILS.Width = Abs(picMaxWidth) '此处单位是厘米。如果Word设置页边距为适中，则中间内容宽17.08CM
                '注意：如果此处不设置图片高度，即使锁定纵横比，图片纵横比也会改变，不知道为什么？
                oILS.Height = oILS.Width * picHeight / picWidth 'CentimetersToPoints(7)
            End If
            '可能超过宽度调节后，高度还是超出了
            If oILS.Height > picMaxHeight Then
                oILS.Height = Abs(picMaxHeight)
                oILS.Width = oILS.Height * picWidth / picHeight
            End If

            'oILS.Range.Select
            'Selection.ClearFormatting
            'Selection.Range.Paragraphs.Alignment = wdAlignParagraphCenter
            With oILS
                .Range.ParagraphFormat.Reset
                '.Range.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle '单倍行距
                .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter '居中
            End With
        End If
    Next
End Sub
 
上述代码注意两点，一是即使设置了锁定纵横比，如果只设置了宽度或者高度其一，图片依然没有等比例缩小，所以高度和宽度都要设置才行。
 
二是宽度缩小后，高度仍可能超出页面，所以还需要对高度再检查和缩小一次。

Dim WordApp As Object
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Dim WordDoc As Object
Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\TEST.docx")

PicPath="图片地址"
WordApp.ActiveDocument.Bookmarks("BM1_1").Range.Select 'Word里定义书签BM1_1
Set Pic = WordApp.Selection.InlineShapes.AddPicture(Filename:=PicPath, SaveWithDocument:=True) '插入图片
Set Shape = Pic.ConvertToShape '转为Shape后才可以调整
Shape.Top = Shape.Top + 10
Shape.Left =  10
Shape.Width = 10
Shape.Height = 10

'嵌入式  -未验证
Shape.WrapFormat.Type = wdWrapTight '紧密环绕

'wdWrapInline 嵌入式
'wdWrapNone 改为默认
'wdWrapSquare 四周环绕
'wdWrapThrough 穿越环绕
'wdWrapTopBottom 上下环绕
 
因为要用到Word中的一些常规变量，所以需要引用Microsoft Word 16.0 Object Library  （版本号16因各人PC中安装的版本不同）