We help IT Professionals succeed at work.

Image size

CompuTurk
CompuTurk asked
on
Medium Priority
313 Views
Last Modified: 2012-05-05
Hi all,
   I was wondering if there is a way to figure out the size a .jpg or a .gif file using VBA scripting.


Thank you...
-Computurk
Comment
Watch Question

Web / Application Developer
CERTIFIED EXPERT
Commented:
Say you have just on picture in your excel worksheet.

'This two lines of code resize it with 2 times
Sheet1.Shapes(1).ScaleWidth 2, msoFalse, msoScaleFromTopLeft
Sheet1.Shapes(1).ScaleHeight 2, msoFalse, msoScaleFromTopLeft

First parameter is the resize factor
Second one: according to original size or not
Third one is the place which corner it should be resized

    'msoScaleFromBottomRight
    'msoScaleFromMiddle
    'msoScaleFromTopLeft


Did you need this?

suat

Author

Commented:
What I really need to do is that I have en excel sheet that has references to the images in one of the directories.  I would like Excel to open each graphic figure out its height and width and make a record of it.

Are we on the same page?

Thanks...
-CompuTurk
Suat OzgurWeb / Application Developer
CERTIFIED EXPERT

Commented:
CompuTurk,

Say you have a picture in given path below:

Open a new excel workbook and paste this into module of the sheet.

Sub MacroX()
dim PicName as string
    'Change this value to this your picture name
    PicName = "C:\WINDOWS\Desktop\untitled11.jpg"
    ActiveSheet.Pictures.Insert(PicName).Select
    Sheet1.Shapes(1).Width = 100
    Sheet1.Shapes(1).Height = 100
End Sub

And run. You will see what's going on then you can tell me what you want to exactly do may be.

suat
Suat OzgurWeb / Application Developer
CERTIFIED EXPERT

Commented:
And say A1 has the file name with full path then you will use this code to open that picture:

ActiveSheet.Pictures.Insert(Range("A1")).Select

Do you want to open all pictures in range and resize them then locate on the sheet? Actually it is easy with this code but if you want further info please let me know.

suat
Suat OzgurWeb / Application Developer
CERTIFIED EXPERT

Commented:
And one more try :

Say you have these values in A1 and A2

C:\WINDOWS\Desktop\Untitled1.jpg
C:\WINDOWS\Desktop\Untitled2.jpg
C:\WINDOWS\Desktop\Untitled3.jpg

And you want to get the heights and widths of these pictures and write into B and C columns. Then;

Sub GetPictureSize()
    For i = 1 To 3
        ActiveSheet.Pictures.Insert (Cells(i, 1))
        Cells(i, 2) = Sheet1.Shapes(1).Width
        Cells(i, 3) = Sheet1.Shapes(1).Height
        Sheet1.Shapes(1).Delete
    Next i
End Sub


More?
Or i am still not in the same page with you?

:)

suat
Suat OzgurWeb / Application Developer
CERTIFIED EXPERT

Commented:
err; A1,A2,A3 i mean...
Richie_SimonettiIT Operations
CERTIFIED EXPERT

Commented:
Usage:
PrintSize range("a1")


' Code:

Option Explicit
Private Type POINTAPI
        x As Long
        y As Long
End Type

Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function SetMapMode Lib "gdi32" (ByVal hdc As Long, ByVal nMapMode As Long) As Long
Private Declare Function LPtoDP Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long

Private Function HiMetricToPixels(HiMetricX As Long, HiMetricY As Long, _
                                  PixelsX As Long, PixelsY As Long) As Boolean
'=========================================================================
'   HiMetricToPixels - Converts hi-metric units to pixels. Hi-metric is
'   units expressed via the varios OLE Picture objects.
'
'   NOTE: CONSIDER USING LogicalToDeviceX/Y in place of this function ****
'
'   HiMetricX           The X unit to convert.
'   HiMetricY           The Y unit to convert.
'   PixelsX             Output. The converted X unit.
'   PixelsY             Output. The converted Y unit.
'=========================================================================
   
    Const MM_HIMETRIC   As Long = 3
    Dim MapPt           As POINTAPI         ' Stores a point (x,y) to help convert from HIMETRIC to pixels.
    Dim SavedMapMode    As Integer          ' Stores the old map mode.
    Dim WidthOut        As Long             ' Holds picture width in pixels.
    Dim HgtOut          As Long             ' Holds picture height in pixels.
    Dim ReturnValue     As Long             ' Holds API return values.
    Dim DC              As Long             ' Screen DC
   
    ' get the screen device
    DC = GetDC(0&)
   
    ' Set the mapmode of the hdc to HIMETRIC
    ' and calculate the size in pixels
    SavedMapMode = SetMapMode(DC, MM_HIMETRIC)
   
    ' Save hi-metric values
    MapPt.x = HiMetricX
    MapPt.y = HiMetricY
   
    ' LPtoDP will convert the width and height to pixels.
    ReturnValue = LPtoDP(DC, MapPt, 1)
    If ReturnValue = 0 Then
       ' Restore SavedMapMode and exit
       GoTo ExitLabel
    End If

    ' Return the result
    PixelsX = Abs(MapPt.x): PixelsY = Abs(MapPt.y)

ExitLabel:

    ' Restore the mapping mode as it was
    ' & release the device context
    Select Case SavedMapMode
    Case 0, -1 'invalid_handle_value
    Case Else
        ReturnValue = SetMapMode(DC, SavedMapMode)
        ReleaseDC 0&, DC
    End Select

End Function

Private Function PrintSizes(sPath As range)
Dim sPic As StdPicture
Dim XSize As Long, YSize As Long
If sPath <> "" Then
    Set sPic = LoadPicture(sPath.text)
    HiMetricToPixels sPic.Height, sPic.Width, XSize, YSize
    Debug.Print XSize; YSize
End If
End Function

Author

Commented:
I am going to modify these codes and see which one fits best into my overall application.  I will let you guys know as soon as possible how that goes.

Thank you so far for you help!
-Serkan
Suat OzgurWeb / Application Developer
CERTIFIED EXPERT

Commented:
And?

Author

Commented:
Thanks...

(Tesekkurler!)

-CompuTurk
Suat OzgurWeb / Application Developer
CERTIFIED EXPERT

Commented:
It's my pleasure. Thanks for the grade.

(her zaman)

suat
Richie_SimonettiIT Operations
CERTIFIED EXPERT

Commented:
Ah!, you only need working code not fast one, sorry.

Explore More ContentExplore courses, solutions, and other research materials related to this topic.