当然了，除读取尺寸还应该有文件名才行。文件名我是知道咋搞的，尺寸整水懂
Sub test()
filepath = ThisWorkbook.Path & "\"
picfile = Dir(filepath & "*.jpg") '读jpg格式文件
i = 2
Do While picfile <> ""
ActiveSheet.Pictures.Insert(filepath & picfile).Select
h = Selection.ShapeRange.Height / 28.346
w = Selection.ShapeRange.Width / 28.346
Selection.Delete
Cells(i, 1) = picfile
Cells(i, 2) = h
Cells(i, 3) = w
picfile = Dir
i = i + 1
Loop
End Sub
filepath = ThisWorkbook.Path & "\"
picfile = Dir(filepath & "*.jpg") '读jpg格式文件
i = 2
Do While picfile <> ""
ActiveSheet.Pictures.Insert(filepath & picfile).Select
h = Selection.ShapeRange.Height / 28.346
w = Selection.ShapeRange.Width / 28.346
Selection.Delete
Cells(i, 1) = picfile
Cells(i, 2) = h
Cells(i, 3) = w
picfile = Dir
i = i + 1
Loop
End Sub
温馨提示：答案为网友推荐，仅供参考
第1个回答 2013-10-19
Public Function GetImageSize(sFileName As String, Optional getWidth As Boolean = True) As Long
On Error Resume Next
Dim iFN As Integer
Dim bTemp(3) As Byte
Dim lFlen As Long
Dim lPos As Long
Dim bHmsb As Byte
Dim bHlsb As Byte
Dim bWmsb As Byte
Dim bWlsb As Byte
Dim bBuf(7) As Byte
Dim bDone As Byte
Dim iCount As Integer
Dim gisWidth As Long
Dim gisHeight As Long
lFlen = FileLen(sFileName)
iFN = FreeFile
Open sFileName For Binary As iFN
Get #iFN, 1, bTemp()
'PNG 文件
If bTemp(0) = &H89 And bTemp(1) = &H50 And bTemp(2) = &H4E _
And bTemp(3) = &H47 Then
Get #iFN, 19, bWmsb
Get #iFN, 20, bWlsb
Get #iFN, 23, bHmsb
Get #iFN, 24, bHlsb
gisWidth = CombineBytes(bWlsb, bWmsb)
gisHeight = CombineBytes(bHlsb, bHmsb)
End If
'GIF 文件
If bTemp(0) = &H47 And bTemp(1) = &H49 And bTemp(2) = &H46 _
And bTemp(3) = &H38 Then
Get #iFN, 7, bWlsb
Get #iFN, 8, bWmsb
Get #iFN, 9, bHlsb
Get #iFN, 10, bHmsb
gisWidth = CombineBytes(bWlsb, bWmsb)
gisHeight = CombineBytes(bHlsb, bHmsb)
End If
'JPEG 文件
If bTemp(0) = &HFF And bTemp(1) = &HD8 And bTemp(2) = &HFF Then
Debug.Print "JPEG "
lPos = 3
Do
Do
Get #iFN, lPos, bBuf(1)
Get #iFN, lPos + 1, bBuf(2)
lPos = lPos + 1
Loop Until (bBuf(1) = &HFF And bBuf(2) <> &HFF) Or lPos > lFlen
For iCount = 0 To 7
Get #iFN, lPos + iCount, bBuf(iCount)
Next iCount
If bBuf(0) >= &HC0 And bBuf(0) <= &HC3 Then
bHmsb = bBuf(4)
bHlsb = bBuf(5)
bWmsb = bBuf(6)
bWlsb = bBuf(7)
bDone = 1
Else
lPos = lPos + (CombineBytes(bBuf(2), bBuf(1))) + 1
End If
Loop While lPos < lFlen And bDone = 0
gisWidth = CombineBytes(bWlsb, bWmsb)
gisHeight = CombineBytes(bHlsb, bHmsb)
End If
'BMP 文件
If bTemp(0) = &H42 And bTemp(1) = &H4D Then
Get #iFN, 19, bWlsb
Get #iFN, 20, bWmsb
Get #iFN, 23, bHlsb
Get #iFN, 24, bHmsb
gisWidth = CombineBytes(bWlsb, bWmsb)
gisHeight = CombineBytes(bHlsb, bHmsb)
End If
Close iFN
GetImageSize = gisWidth
If Not getWidth Then GetImageSize = gisHeight
End Function
Private Function CombineBytes(lsb As Byte, msb As Byte) As Long
CombineBytes = CLng(lsb + (msb * 256)) '把十六进制数换成十进制
End Function
On Error Resume Next
Dim iFN As Integer
Dim bTemp(3) As Byte
Dim lFlen As Long
Dim lPos As Long
Dim bHmsb As Byte
Dim bHlsb As Byte
Dim bWmsb As Byte
Dim bWlsb As Byte
Dim bBuf(7) As Byte
Dim bDone As Byte
Dim iCount As Integer
Dim gisWidth As Long
Dim gisHeight As Long
lFlen = FileLen(sFileName)
iFN = FreeFile
Open sFileName For Binary As iFN
Get #iFN, 1, bTemp()
'PNG 文件
If bTemp(0) = &H89 And bTemp(1) = &H50 And bTemp(2) = &H4E _
And bTemp(3) = &H47 Then
Get #iFN, 19, bWmsb
Get #iFN, 20, bWlsb
Get #iFN, 23, bHmsb
Get #iFN, 24, bHlsb
gisWidth = CombineBytes(bWlsb, bWmsb)
gisHeight = CombineBytes(bHlsb, bHmsb)
End If
'GIF 文件
If bTemp(0) = &H47 And bTemp(1) = &H49 And bTemp(2) = &H46 _
And bTemp(3) = &H38 Then
Get #iFN, 7, bWlsb
Get #iFN, 8, bWmsb
Get #iFN, 9, bHlsb
Get #iFN, 10, bHmsb
gisWidth = CombineBytes(bWlsb, bWmsb)
gisHeight = CombineBytes(bHlsb, bHmsb)
End If
'JPEG 文件
If bTemp(0) = &HFF And bTemp(1) = &HD8 And bTemp(2) = &HFF Then
Debug.Print "JPEG "
lPos = 3
Do
Do
Get #iFN, lPos, bBuf(1)
Get #iFN, lPos + 1, bBuf(2)
lPos = lPos + 1
Loop Until (bBuf(1) = &HFF And bBuf(2) <> &HFF) Or lPos > lFlen
For iCount = 0 To 7
Get #iFN, lPos + iCount, bBuf(iCount)
Next iCount
If bBuf(0) >= &HC0 And bBuf(0) <= &HC3 Then
bHmsb = bBuf(4)
bHlsb = bBuf(5)
bWmsb = bBuf(6)
bWlsb = bBuf(7)
bDone = 1
Else
lPos = lPos + (CombineBytes(bBuf(2), bBuf(1))) + 1
End If
Loop While lPos < lFlen And bDone = 0
gisWidth = CombineBytes(bWlsb, bWmsb)
gisHeight = CombineBytes(bHlsb, bHmsb)
End If
'BMP 文件
If bTemp(0) = &H42 And bTemp(1) = &H4D Then
Get #iFN, 19, bWlsb
Get #iFN, 20, bWmsb
Get #iFN, 23, bHlsb
Get #iFN, 24, bHmsb
gisWidth = CombineBytes(bWlsb, bWmsb)
gisHeight = CombineBytes(bHlsb, bHmsb)
End If
Close iFN
GetImageSize = gisWidth
If Not getWidth Then GetImageSize = gisHeight
End Function
Private Function CombineBytes(lsb As Byte, msb As Byte) As Long
CombineBytes = CLng(lsb + (msb * 256)) '把十六进制数换成十进制
End Function
第2个回答 2013-10-19
即然文件名都可以咋搞的，那图片长宽的话就分别用fil.height和fil.width
