Sub 图片铺满单元格()
'只对单元格内嵌入式图片发生作用，单元格内只存放一个图片，没有其他内容。有其他内容，则会删去
'不保留图片原始比例
'先选中单元格，再执行操作
Dim InSape As InlineShape, OCell As Cell
Dim Rng As Range
Dim i&, jPic&, iPic&
Set Rng = Selection.Range
With Rng
    If .Information(wdWithInTable) And .InlineShapes.Count >= 1 Then '在表格内，且内嵌图片数量大于等于1
        For Each InSape In .InlineShapes
            Set OCell = InSape.Range.Cells(1)
            '删除单元格中，除了图片外的内容。
            i = Len(OCell.Range) - 2 '单元格的range的最后是2个特殊符号，不可动。
            iPic = InStr(1, OCell.Range, "/") '取得图片在单元格内的位置，在VBA中，“/”代表一个嵌入式图片。嵌入式图片当成字符处理。
            If i > 1 Then
                jPic = InSape.Range.End '取得图片在文档中的位置
                If jPic <> jPic + i - iPic Then
                    ActiveDocument.Range(jPic, jPic + i - iPic).Delete '先删除图片后面的多余内容
                End If
                If jPic - iPic <> jPic - 1 Then
                    ActiveDocument.Range(jPic - iPic, jPic - 1).Delete '再删除图片前面的多余内容
                End If
            End If
 
            '设置图片的长度为所在单元格的长宽。
            InSape.LockAspectRatio = msoFalse
            InSape.Width = OCell.Width - CentimetersToPoints(0.38)
            InSape.Height = OCell.Height
            InSape.Range.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
        Next
    Else
        MsgBox "请重新拖动选择，只能选择含有嵌入式图片的行、列、单元格或者整个表格"
        Exit Sub
    End If
End With
End Sub