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都是一样的作用。验证果然。问题解决，完全不用那一片黑压压的代码，清净多了。

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