EXCEL VBA如何获取TIF影像的尺寸

xw11331

如图 我需要箭头所指的数据

liucqa

blog.sina.cn/dpool/blog/s/blog_777d52410101p3z4.html?

小fisher

1. Option Explicit
   
2. 
   
3. Private Type ImageFileHeader
   
4.     ByteOrder As Integer
   
5.     Version As Integer
   
6.     Offset(3) As Byte
   
7. End Type
   
8. 
   
9. Private Type ImageFileDictionary
   
10.     Identifier(1) As Byte
    
11.     FieldType(1) As Byte
    
12.     Count(3) As Byte
    
13.     ValueOffset(3) As Byte
    
14. End Type
    
15. 
    
16. Private Type TiffDimension
    
17.     Width As Long
    
18.     Height As Long
    
19. End Type
    
20. 
    
21. Function GetTiffDimension(tiffFile As String) As TiffDimension '主函数，根据tif文件名返回图像尺寸
    
22.     Dim iFreeFile As Integer
    
23.     Dim ifh As ImageFileHeader
    
24.     Dim ifd() As ImageFileDictionary
    
25.     Dim bLittleEndian As Boolean
    
26.     Dim arrBuffer(1) As Byte
    
27.     Dim iIFHcount As Integer
    
28.     Dim i As Integer
    
29.    
    
30.     Dim lOffset As Long
    
31.         
    
32.     iFreeFile = FreeFile
    
33.     Open tiffFile For Binary As iFreeFile
    
34.         Get #iFreeFile, 1, ifh
    
35.         If ifh.ByteOrder = &H4949 Then  '"II" = LittleEndian
    
36.             bLittleEndian = True
    
37.         ElseIf ifh.ByteOrder = &H4D4D Then  '"MM" = BigEndian
    
38.             bLittleEndian = False
    
39.         Else
    
40.             MsgBox "invalid TIFF format"
    
41.             Exit Function
    
42.         End If
    
43.         
    
44.         lOffset = BytesToLong(ifh.Offset, bLittleEndian)
    
45.         Get iFreeFile, lOffset + 1, arrBuffer
    
46.         iIFHcount = BytesToUInt(arrBuffer, bLittleEndian)
    
47.         ReDim ifd(iIFHcount - 1)
    
48.         Get iFreeFile, lOffset + 3, ifd
    
49.         For i = 0 To iIFHcount - 1
    
50.             If BytesToUInt(ifd(i).Identifier, bLittleEndian) = &H100 Then 'image Width
    
51.                 If BytesToUInt(ifd(i).FieldType, bLittleEndian) = 3 Then   '3=Int类型
    
52.                     GetTiffDimension.Width = BytesToUInt(ifd(i).ValueOffset, bLittleEndian)
    
53.                 ElseIf BytesToUInt(ifd(i).FieldType, bLittleEndian) = 4 Then '4=Long类型
    
54.                     GetTiffDimension.Width = BytesToLong(ifd(i).ValueOffset, bLittleEndian)
    
55.                 End If
    
56.             ElseIf BytesToUInt(ifd(i).Identifier, bLittleEndian) = &H101 Then  'image Height
    
57.                 If BytesToUInt(ifd(i).FieldType, bLittleEndian) = 3 Then
    
58.                    GetTiffDimension.Height = BytesToUInt(ifd(i).ValueOffset, bLittleEndian)
    
59.                 ElseIf BytesToUInt(ifd(i).FieldType, bLittleEndian) = 4 Then
    
60.                    GetTiffDimension.Height = BytesToLong(ifd(i).ValueOffset, bLittleEndian)
    
61.                 End If
    
62.             End If
    
63.         Next
    
64.         
    
65.     Close iFreeFile
    
66.    
    
67. End Function
    
68. 
    
69. Function BytesToUInt(b() As Byte, Optional LittleEndian As Boolean = True) As Long  'VBA中没有Unsigned Int数据类型，所以用Long作返回值，避免出生溢出错误
    
70.     If LittleEndian Then
    
71.         BytesToUInt = CLng(b(1)) * &H100 + b(0)
    
72.     Else
    
73.         BytesToUInt = CLng(b(0)) * &H100 + b(1)
    
74.     End If
    
75. End Function
    
76. 
    
77. Function BytesToLong(b() As Byte, Optional LittleEndian As Boolean = True) As Long
    
78.     If LittleEndian Then
    
79.         BytesToLong = CLng(b(3)) * &H1000000 + b(2) * &H10000 + b(1) * &H100 + b(0)
    
80.     Else
    
81.         BytesToLong = CLng(b(0)) * &H1000000 + b(1) * &H10000 + b(2) * &H100 + b(3)
    
82.     End If
    
83. End Function
    
84. 
    
85. Sub GetDimension()  '测试代码
    
86.     Dim gfd As TiffDimension
    
87.     Dim sFileName As String
    
88.     Dim iRow As Integer
    
89.     sFileName = Application.GetOpenFilename("tif格式图片(*.tif),*.tif", , "请选择要查看的tif文件")
    
90.     If sFileName = "False" Then Exit Sub
    
91.     gfd = GetTiffDimension(sFileName)
    
92.     iRow = Sheet1.Range("a65536").End(xlUp).Row + 1
    
93.     Sheet1.Cells(iRow, 1) = sFileName
    
94.     Sheet1.Cells(iRow, 2) = gfd.Width
    
95.     Sheet1.Cells(iRow, 3) = gfd.Height
    
96. End Sub
    

复制代码

1808835746

学无止境，山外有山；高山仰止，信步登攀。

fxl447098457

下面就可以实现了。
Sub ts()
Dim w As Object
Set w = VBA.CreateObject("wia.imagefile")
w.loadfile "C:\Users\Fanxiaolei\Desktop\timg.tif"
MsgBox "图分辨率为:" & w.Width & "X" & w.Height
End Sub