|
如下代码,向打开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 往大虾指导,不胜感激。
|
|