office插件开发shapes.addpicture插入图片保存原始大小

// 就是最后两个参数(红色显示)传-1即可,在excel2007中验证通过,其他未验证。

CComPtr<Excel::Shape> pShape = pShapes->AddPicture(bstrPicName, msoFalse, msoCTrue, 0, 0, -1, -1);


    项目中,需要向office中插入一个图片,但是同事的代码总是会有缩放,不是原始大小。我查看了他的代码,最后两个参数写了个固定值。推断是这两个参数引起。在ms office中这两个参数必选。第一想法当然是获取原始大小,自己写函数,还要转成磅值,感觉很麻烦。网上已经给出相关函数,黑压压一片:(参考http://www.excelpx.com/thread-311275-1-1.html

'***************************************************
'* 模 块 名:mdLSPicSize
'* 功能描述:读取图片尺寸信息(不加载图片,支持PNG)
'* 作    者:
'* 作者博客:
'* 日    期:2012-01-21 21:39
'* 版    本:V1.0.0
'***************************************************
'整行注释的为在读取图片尺寸时不需要的文件头信息
'BMP文件头
Private Type BitmapFileHeader
    bfType As Integer    '标识 0,1 两个字节为 42 4D 低位在前,即 19778
    bfReserved2 As Integer
    bfOffBits As Long
    bfReserved1 As Integer
    bfSize As Long
End Type
Private Type BitmapInfoHeader
    biSize As Long
    biWidth As Long    '宽度 18,19,20,21 四个字节,低位在前
    biHeight As Long    '高度 22,23,24,25 四个字节,低位在前
    '  biPlanes As Integer
    '  biBitCount As Integer
    '  biCompression As Long
    '  biSizeImage As Long
    '  biXPelsPerMeter As Long
    '  biYPelsPerMeter As Long
    '  biClrUsed As Long
    '  biClrImportant As Long
End Type
'JPEG(这个好麻烦)
Private Type LSJPEGHeader
    jSOI As Integer    '图像开始标识 0,1 两个字节为 FF D8 低位在前,即 -9985
    jAPP0 As Integer    'APP0块标识 2,3 两个字节为 FF E0
    jAPP0Length(1) As Byte   'APP0块标识后的长度,两个字节,高位在前
    '  jJFIFName As Long         'JFIF标识 49(J) 48(F) 44(I) 52(F)
    '  jJFIFVer1 As Byte         'JFIF版本
    '  jJFIFVer2 As Byte         'JFIF版本
    '  jJFIFVer3 As Byte         'JFIF版本
    '  jJFIFUnit As Byte
    '  jJFIFX As Integer
    '  jJFIFY As Integer
    '  jJFIFsX As Byte
    '  jJFIFsY As Byte
End Type
Private Type LSJPEGChunk
    jcType As Integer    '标识(按顺序):APPn(0,1~15)为 FF E1~FF EF; DQT为 FF DB(-9217)
    'SOFn(0~3)为 FF C0(-16129),FF C1(-15873),FF C2(-15617),FF C3(-15361)
    'DHT为 FF C4(-15105); 图像数据开始为 FF DA
    jcLength(1) As Byte    '标识后的长度,两个字节,高位在前
    '若标识为SOFn,则读取以下信息;否则按照长度跳过,读下一块
    jBlock As Byte    '数据采样块大小 08 or 0C or 10
    jHeight(1) As Byte    '高度两个字节,高位在前
    jWidth(1) As Byte    '宽度两个字节,高位在前
    '  jColorType As Byte        '颜色类型 03,后跟9字节,然后是DHT
End Type
'PNG文件头
Private Type LSPNGHeader
    pType As Long    '标识 0,1,2,3 四个字节为 89 50(P) 4E(N) 47(G) 低位在前,即 1196314761
    pType2 As Long    '标识 4,5,6,7 四个字节为 0D 0A 1A 0A
    pIHDRLength As Long    'IHDR块标识后的长度,疑似固定 00 0D,高位在前,即 13
    pIHDRName As Long    'IHDR块标识 49(I) 48(H) 44(D) 52(R)
    Pwidth(3) As Byte    '宽度 16,17,18,19 四个字节,高位在前
    Pheight(3) As Byte    '高度 20,21,22,23 四个字节,高位在前
    '  pBitDepth As Byte
    '  pColorType As Byte
    '  pCompress As Byte
    '  pFilter As Byte
    '  pInterlace As Byte
End Type
'GIF文件头(这个好简单)
Private Type LSGIFHeader
    gType1 As Long    '标识 0,1,2,3 四个字节为 47(G) 49(I) 46(F) 38(8) 低位在前,即 944130375
    gType2 As Integer    '版本 4,5 两个字节为 7a单幅静止图像9a若干幅图像形成连续动画
    gWidth As Integer    '宽度 6,7 两个字节,低位在前
    gHeight As Integer    '高度 8,9 两个字节,低位在前
End Type
Public Function PictureSize(ByVal picPath As String, ByRef Width As Long, ByRef Height As Long) As String
    Dim iFile As Integer
    Dim jpg As LSJPEGHeader
    Width = 0: Height = 0             '预输出:0 * 0
    If picPath = "" Then PictureSize = "null": Exit Function          '文件路径为空
    If Dir(picPath) = "" Then PictureSize = "not exist": Exit Function    '文件不存在
    PictureSize = "error"             '预定义:出错
    iFile = FreeFile()
    Open picPath For Binary Access Read As #iFile
    Get #iFile, , jpg
    If jpg.jSOI = -9985 Then
        Dim jpg2 As LSJPEGChunk, pass As Long
        pass = 5 + jpg.jAPP0Length(0) * 256 + jpg.jAPP0Length(1)      '高位在前的计算方法
        PictureSize = "JPEG error"    'JPEG分析出错
        Do
            Get #iFile, pass, jpg2
            If jpg2.jcType = -16129 Or jpg2.jcType = -15873 Or jpg2.jcType = -15617 Or jpg2.jcType = -15361 Then
                Width = jpg2.jWidth(0) * 256 + jpg2.jWidth(1)
                Height = jpg2.jHeight(0) * 256 + jpg2.jHeight(1)
                PictureSize = Width & "*" & Height
                'PictureSize = "JPEG"  'JPEG分析成功
                Stop
                Exit Do
            End If
            pass = pass + jpg2.jcLength(0) * 256 + jpg2.jcLength(1) + 2
        Loop While jpg2.jcType <> -15105    'And pass < LOF(iFile)
    ElseIf jpg.jSOI = 19778 Then
        Dim bmp As BitmapInfoHeader
        Get #iFile, 15, bmp
        Width = bmp.biWidth
        Height = bmp.biHeight
        PictureSize = Width & "*" & Height
        ' PictureSize = "BMP"           'BMP分析成功
    Else
        Dim png As LSPNGHeader
        Get #iFile, 1, png
        If png.pType = 1196314761 Then
            Width = png.Pwidth(0) * 16777216 + png.Pwidth(1) * 65536 + png.Pwidth(2) * 256 + png.Pwidth(3)
            Height = png.Pheight(0) * 16777216 + png.Pheight(1) * 65536 + png.Pheight(2) * 256 + png.Pheight(3)
            PictureSize = Width & "*" & Height
            'PictureSize = "PNG"       'PNG分析成功
        ElseIf png.pType = 944130375 Then
            Dim gif As LSGIFHeader
            Get #iFile, 1, gif
            Width = gif.gWidth
            Height = gif.gHeight
            PictureSize = Width & "*" & Height
            'PictureSize = "GIF"       'GIF分析成功
        Else
            PictureSize = "unknow"    '文件类型未知
        End If
    End If
    Close #iFile
End Function
'*************************以下是测试代码
Sub test()
    Dim w As Long, h As Long
    Dim f As String    '图片文件完成路径
    Dim t As String
    Dim Pwidth As Long, Pheight As Long
    Dim Psize As String
    f = "D:\红烤全虾.jpg"  '图片文件完成路径
    Psize = PictureSize(f, w, h)    '运行宏,w,h就是对应图片的width height  ,返回 width*height
    If Len(Psize) > 0 Then
        Pwidth = Val(Split(Psize, "*")(0))  '返回 图片 宽
        Pheight = Val(Split(Psize, "*")(1))    '返回 图片 高
    End If
End Sub


    我是个懒人,喜欢追求简单完美,觉得不应该这样麻烦,应该有个0的默认值是原始大小之类的。后来在wps上看到他们的函数使用说明(http://www.wps.cn/wpsapi/apishow/type-WPP-AddPicture.htm)。他们的最后两个大小参数可以不传入,默认值-1。顿时觉得可以触类旁通,虽然ms的必须要传入大小参数,或许默认值-1都是一样的作用。验证果然。问题解决,完全不用那一片黑压压的代码,清净多了。


    本来,写程序就不应该那么死板,要灵活多变吗。

评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值