ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Excel height and width of a pictures (https://www.excelbanter.com/excel-programming/394702-excel-height-width-pictures.html)

Андрей Андриенко

Excel height and width of a pictures
 
Hi!

Prompt how to receive parametres of a picture by means of VBA for Excel, namely height and width in pixels.

Which I apply an example more low, does not work properly.

Private Type ThePicInfo

Type As String

Width As Long

Height As Long

End Type

Private Function CheckPicSpecs (TheFile) As ThePicInfo

Dim TheContent, TheImageInfo As ThePicInfo, TheVar, TheFreeFile

TheFreeFile = FreeFile

Open TheFile For Binary As TheFreeFile

TheContent = Input (10, TheFreeFile)

Close TheFreeFile

If Mid (TheContent, 7, 4) = "JFIF" Then

TheImageInfo. Type = "JPG"

Open TheFile For Binary As TheFreeFile

TheContent = Input (167, TheFreeFile)

Close TheFreeFile

TheImageInfo. Height = Asc (Mid (TheContent, 165, 1)) + 256 *

Asc (Mid (TheContent, 164, 1))

TheImageInfo. Width = Asc (Mid (TheContent, 167, 1)) + 256 *

Asc (Mid (TheContent, 166, 1))

End If

If Mid (TheContent, 1, 3) = "GIF" Then

TheImageInfo. Type = "GIF"

TheImageInfo. Width = Asc (Mid (TheContent, 7, 1)) + 256 * Asc (Mid (TheContent,

8, 1))

TheImageInfo. Height = Asc (Mid (TheContent, 9, 1)) + 256 * Asc (Mid (TheContent,

10, 1))

End If

CheckPicSpecs = TheImageInfo

End Function

Private Sub Command1_Click ()

Dim an As ThePicInfo

' as parametre of function CheckPicSpecs instal path to your picture

a = CheckPicSpecs ("D:\garbage\way2house.gif")

MsgBox a. Type

MsgBox a. Width

MsgBox a. Height

End Sub





Thankful in advance




All times are GMT +1. The time now is 01:17 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com