How to insert picture with exact Scaleheight ScaleWidth , Height, and width

[NimishK]

Hi

When i see the image inserted in a cell thru coding and its height width properties are dispalyed as 2.28 cm and 16.27 cm respectively
ScaleHeight and Scale width shows 100%

but in the original excel sheet the same image created in the sheet is at 2.12 cm Height 16.27 cm width ScaleWidth = 95% and scale height 141%

Now how can i insert the image in a cell with exact above requirement ie with
2.12 cm Height 16.27 cm width ScaleWidth = 95% and scale height 141%

Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
dim picPath as String
picPath = "C:\Nim\" & "pict1.jpg"


With ws
.Activate
.Range("A1:J1").MergeCells = True
.Range("A1:J1").RowHeight = "85.5"
.Pictures.Insert (picPath)
.Pictures.Left = View_Prof.Range("A1:J1").Left
.Pictures.Top = View_Prof.Range("A1:J1").Top


End With

Thanks NimishK

 

[bobsan42]

this is what I previously used:

      Dim s As Object
     Dim rr1 As Range: Set rr1 = ActiveCell 
    
    Set s = ActiveSheet.Shapes.AddPicture(iimagename, True, True, rr1.Left, rr1.Top, 100, 100)
    s.ScaleHeight Factor:=.95, RelativeToOriginalSize:=msoTrue
    s.ScaleWidth Factor:=.95, RelativeToOriginalSize:=msoTrue
    s.LockAspectRatio = msoTrue

Adjust to suite your needs.

 

[NimishK]

Bob
Thanks but what needs to be multiplied or divided

s.ScaleHeight Factor:=0.95, RelativeToOriginalSize:=msoTrue
s.ScaleWidth Factor:=0.95, RelativeToOriginalSize:=msoTrue

to get 2.12 cm Height 16.27 cm width ScaleWidth = 95% and scale height 141%

 

[bobsan42]

Now when I look at it RelativeToOriginalSize should be FALSE.
However - why are the scales so important? Isn't it the size that matters in the end?
i did play with this a while. But was only partially successful.
The math is relatively simple:
to get 2.12 @ 141% the height must be 1.50 cm (/2.54*72=approx 42.5 points)
to get 16.27 @ 95% the height must be 17.13 cm (/2.54*72=approx 485.6 points)

Now the image you insert comes with its own dimensions. With these dimensions it goes into the workbook.

Simplest is to have the images to be inserted with these exact dimensions.
Then you can use this code:

    Dim s As Shape
    Dim rr1 As Range: Set rr1 = ActiveCell
    Dim iimagename As String: iimagename = "c:\Users\borisovbor04\Pictures\death-clip-art-black-transparent-grim-reaper.png"


    Set s = ActiveSheet.Shapes.AddPicture(iimagename, True, True, rr1.Left, rr1.top, -1, -1)
    s.LockAspectRatio = False
    s.ScaleHeight Factor:=1.41, RelativeToOriginalSize:=True
    s.ScaleWidth Factor:=0.95, RelativeToOriginalSize:=True
    s.LockAspectRatio = True
    Set s = Nothing
    Set rr1 = Nothing

Unfortunately this is usually not the case. One way is to change the dimensions to what you need in advance, the other is to change them in excel.
AFAIK to change the actual size of the image you have to compress it.

    Set s = ActiveSheet.Shapes.AddPicture2(iimagename, False, True, rr1.Left, rr1.top, 42.5, 485.6, msoPictureCompressTrue)

This actually works until you save the workbook - then the image is compressed again and the actual size is changed again and the scales are back to 100%.
There is and option "Do not compress images in file" - unfortunately when it is ON image is not compressed upon inserting, when it is OFF the image is re-compressed upon saving. So if you have more than 1 images in a file programming this will be a tedious thing.
So is scaling really that important?

 

[NimishK]

Bit confussed

Now when I look at it RelativeToOriginalSize should be FALSE.

Your Code marked in RED : is not matching with the above statement

Dim s As Shape
    Dim rr1 As Range: Set rr1 = ActiveCell
    Dim iimagename As String: iimagename = "c:\Users\borisovbor04\Pictures\death-clip-art-black-transparent-grim-reaper.png"


    Set s = ActiveSheet.Shapes.AddPicture(iimagename, True, True, rr1.Left, rr1.top, -1, -1)
    s.LockAspectRatio = False
[B][COLOR=#ff0000]    s.ScaleHeight Factor:=1.41, RelativeToOriginalSize:=True[/COLOR][/B]
[B][COLOR=#ff0000]    s.ScaleWidth Factor:=0.95, RelativeToOriginalSize:=True[/COLOR][/B]
    s.LockAspectRatio = True
    Set s = Nothing
    Set rr1 = Nothing

Scaling is Not at All important. Absolutely Right
Unfortunately In My case i can't really play with it. It is what the exact representation i desire. i.e Why VBA coding else i would not have posted this threaad
And my worksheet clears the Format and Clears the Content. By the Way the original image size
Height = 2.23
Width= 11.56
when picture physically and created in the WrkSheet the size it turned to Height 2.12 cm and width 163 cm
so thru coding how can i assign the values directly in syntax

Set s = ActiveSheet.Shapes.AddPicture(iimagename, True, True, rr1.Left, rr1.top, [COLOR=#ff0000][B]163cm, 2.12CM[/B][/COLOR]) ' Exact Values of Points of 163cm and 2.12.cms

to get 2.12 @ 141% the height must be 1.50 cm (/2.54*72=approx 42.5 points)
to get 16.27 @ 95% the height must be 17.13 cm (/2.54*72=approx 485.6 points)

So as per the formula given by you do what value is divded is it 2.12/2.54*72 or is it 1.50/2.54*72 or 150/2.54*72
so that i can get the Point value of 163cm Width and 2.12cm Height

Thankx NimishK

 

[bobsan42]

The code marked in red is not incorrect - just this is the case when the inserted image has preset the necessary size.

the width and height in the AddPicture method are to be provided in POINTS.
there are 72 POINTS in 1 inch; 2.54 cm in 1 inch => 2.54 cm contain 72 points
so for 2.12cm -> 2.12/2.54*72 = 60.0945 points
for 163 cm -> 163/2.54*72 = 4 620.4724 points

or look up an online converter - the values may come out slightly different.

 

[NimishK]

Thanks Bob
for your valuable inputs and guidance. Yes got it with simple division.
Thankx Very much
NimishK