ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 2275|回复: 0

[求助] VBA word插入图片位置

[复制链接]

TA的精华主题

TA的得分主题

发表于 2015-6-17 11:30 | 显示全部楼层 |阅读模式
如下代码,向打开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  往大虾指导,不胜感激。





您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2025-1-16 02:46 , Processed in 0.016974 second(s), 8 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表