今天有个网友有2000多张照片要取图片标题及相关的尺寸出来,不想手工处理,就想到用VBA批量实现出来,分享一下代码。
获取图片的尺寸(如宽度或高度),那使用VBA如何来实现呢?
一、使用LoadPicture及GetObjectAPI来获取
Private Declare Function GetObjectAPI Lib "gdi32" Alias"GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObjectAs Any) As Long
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Public Sub GetPicSize()
Dim bm As BITMAP
Dim pic As IPictureDisp
Set pic =stdole.LoadPicture("d:\test.Jpg")
Call GetObjectAPI(pic, Len(bm),bm)
MsgBox "你指定的图片大小 : 宽 " &bm.bmWidth & "×高 " &bm.bmHeight
End Sub
二、使用LoadPicture及Wscript来获取
Option Explicit
Dim pic As Object
Set pic = LoadPicture("D:\Test.jpg")
WScript.Echo "Width: "& Himetric2Pixel(pic.Width)
WScript.Echo "Height: " & Himetric2Pixel(pic.Height)
Function Himetric2Pixel(n)
'1 Inch = 2540 Himetric
Const key ="HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI"
Dim WshShell, dpi
Set WshShell =WScript.CreateObject("Wscript.Shell")
dpi = WshShell.RegRead(key)
Himetric2Pixel = Round(n * dpi /2540)
End Function
获取图片的尺寸(如宽度或高度),那使用VBA如何来实现呢?
一、使用LoadPicture及GetObjectAPI来获取
Private Declare Function GetObjectAPI Lib "gdi32" Alias"GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObjectAs Any) As Long
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Public Sub GetPicSize()
Dim bm As BITMAP
Dim pic As IPictureDisp
Set pic =stdole.LoadPicture("d:\test.Jpg")
Call GetObjectAPI(pic, Len(bm),bm)
MsgBox "你指定的图片大小 : 宽 " &bm.bmWidth & "×高 " &bm.bmHeight
End Sub
二、使用LoadPicture及Wscript来获取
Option Explicit
Dim pic As Object
Set pic = LoadPicture("D:\Test.jpg")
WScript.Echo "Width: "& Himetric2Pixel(pic.Width)
WScript.Echo "Height: " & Himetric2Pixel(pic.Height)
Function Himetric2Pixel(n)
'1 Inch = 2540 Himetric
Const key ="HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI"
Dim WshShell, dpi
Set WshShell =WScript.CreateObject("Wscript.Shell")
dpi = WshShell.RegRead(key)
Himetric2Pixel = Round(n * dpi /2540)
End Function