当前位置:首页经验技巧Excel经验excel入门

excel怎么保持原图

2026-01-13 10:35:25

1.EXCEL批量添加图片批注后怎么让图片保持原图比例

你新建一个模块,插入如下代码:Private Type BitmapFileHeader bfType As Integer '标识 0,1 两个字节为 42 4D 低位在前,即 19778 bfReserved2 As Integer bfOffBits As Long bfReserved1 As Integer bfSize As LongEnd TypePrivate 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 LongEnd 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 ByteEnd TypePrivate 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字节,然后是DHTEnd 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 ByteEnd 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 TypePublic 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 #iFileEnd Function然后在你的代码上做如下修改:Sub 批量。


免责声明:本站信息来自网络收集及网友投稿,仅供参考,如果有错误请反馈给我们更正,对文中内容的真实性和完整性本站不提供任何保证,不承但任何责任,谢谢您的合作。
版权所有:五学知识网 Copyright © 2015-2026 www.z8000w.com. All Rights Reserved .