VBA word插入图片位置解决方法 / 开普饭

VBA word插入图片位置
如下代码，向打开word文档中每页固定位置插入相同图片：

Sub TestInsertPic()
    Dim bRet As Boolean
    Dim picPath As String
    picPath = "D:\a.bmp"

    ret = InsertPic(picPath, 47, 10, 50, 10)

    'MsgBox bRet
End Sub

'word中每页插入图片    长度单位均为毫米
'picPath      图片路径
'picWidth     图片宽度
'picHeight    图片高度
'picRight     图片右侧距页面右侧的距离
'picBottom    图片底部距页面底部的距离
'
Function InsertPic(picPath As String, picWidth As Single, picHeight As Single, picRight As Single, picBottom As Single) As Boolean
    Dim pageCount As Integer
    Dim pIndex As Integer
    Dim oDoc  As Document
    Dim oRang As Range
    Dim oShape As Shape
    Dim olShape As InlineShape
    Dim oPage As Page
    Dim pWidth, pHeight, pLeft, pTop, pRight, pBottom As Integer    '图片位置大小信息
    Dim mRight, mBottom, mLeft, mTop As Integer  '页边距
    Dim pageHeight, pageWidth As Integer 'word页面大小(页边距以内)
    Dim tableTop, tableLeft, tableWidth, tablePaddingLeft As Integer
    Dim oTable As Table
    Dim tableType As Integer
    'Dim p2cUnit As Single

    Set oDoc = ActiveDocument
    Set oPage = oDoc.ActiveWindow.Panes(1).pages(1)
    '获取页边距
    mLeft = oDoc.PageSetup.LeftMargin
    mRight = oDoc.PageSetup.RightMargin
    mBottom = oDoc.PageSetup.BottomMargin
    mTop = oDoc.PageSetup.TopMargin

    '页面大小
    pageHeight = oDoc.PageSetup.pageHeight
    pageWidth = oDoc.PageSetup.pageWidth

    '计算单位，从毫米到磅
    'p2cUnit = 2.835     '1毫米大约等于2.835磅
    pWidth = Application.MillimetersToPoints(picWidth)
    pHeight = Application.MillimetersToPoints(picHeight)
    pRight = Application.MillimetersToPoints(picRight)
    pBottom = Application.MillimetersToPoints(picBottom)

    '获取总页数
    pageCount = GetPageCount()

    '清理之前已经存在的二维码图片
    Dim s As Shape
    For pIndex = 1 To GetPageCount
        On Error Resume Next
        Set oShape = oDoc.Shapes.Item("codebar" & pIndex)

        If Not oShape Is Nothing Then
            oShape.Delete
        End If
        Err.Clear
    Next

    '遍历每页添加图片
    For pIndex = 1 To pageCount
        Set oRang = oDoc.GoTo(wdGoToPage, wdGoToAbsolute, pIndex)

        Set oShape = oDoc.Shapes.AddPicture(picPath, False, True, 0, 0, pWidth, pHeight, oRang)
        oShape.Name = "codebar" & pIndex
        oShape.Select

        '图片的水平位置，相对于边距   单位 磅
        oShape.RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
        oShape.Left = -mLeft + pageWidth - pWidth - pRight
        '图片的垂直位置，相对于边距   单位 磅
        oShape.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
        oShape.Top = -mTop + pageHeight - pHeight - pBottom
    Next

End Function


Function GetPageCount() As Integer
    Dim pageCount As Integer
    pageCount = ActiveDocument.ComputeStatistics(wdStatisticPages, False)
    'MsgBox pageCount
    GetPageCount = pageCount
End Function

问题：
如果插入的页面中存在表格（在页首位置），那么图片可能会插入到表格中，
此时在使用相对位置调整图片的位置就会出现问题。
初用vba 往大虾指导，不胜感激。
------解决思路----------------------
图片位置调整使用shapeRange,同时将layoutIncell属性设置为false

VBA word插入图片位置解决方法

相关推荐