Trying to resize pictures in excel all to the same size

[Nabeel K]

Hi All,

bit of a newbie to Excel, apologies if this has been asked before, trie
searching but was not able to find an answer to it on the site. I have
bunch of pictures in one column (column c), I am trying to resize the
all exactly to a height of 0.98 and width of 1.98. I tried selecting al
of them then resizing in the size ribbon under picture tools howeve
some of the pictures have the lock aspect ratio and relative to origina
picture size options ticked in size and properties. many thanks if yo
can hel

 

[Claus Busch]

Hi,

Am Wed, 25 Sep 2013 11:57:22 +0100 schrieb Nabeel K:

bit of a newbie to Excel, apologies if this has been asked before, tried
searching but was not able to find an answer to it on the site. I have a
bunch of pictures in one column (column c), I am trying to resize them
all exactly to a height of 0.98 and width of 1.98. I tried selecting all
of them then resizing in the size ribbon under picture tools however
some of the pictures have the lock aspect ratio and relative to original
picture size options ticked in size and properties. many thanks if you
can help

try:
Sub Pictures()
Dim shp As Shape

For Each shp In ActiveSheet.Shapes
With shp
.Height = Application.CentimetersToPoints(0.98)
.Width = Application.CentimetersToPoints(1.98)
End With
Next
End Sub

If your standard for measurements are inches change it to:
InchesToPoints


Regards
Claus B.

 

[Nabeel K]

Hi Claus,

appreciative for your prompt response,thank you. Still facing a proble
tho with some of the pictures which have the lock aspect ratio an
relative to original picture size option ticked. Either width or heigh
have changed but not both.

 

[Claus Busch]

Hi,

Am Wed, 25 Sep 2013 14:19:11 +0100 schrieb Nabeel K:

appreciative for your prompt response,thank you. Still facing a problem
tho with some of the pictures which have the lock aspect ratio and
relative to original picture size option ticked. Either width or height
have changed but not both.

try:
Sub Pictures2()
Dim sr
ActiveSheet.Shapes.SelectAll
Set sr = Selection.ShapeRange
With sr
.LockAspectRatio = False
.Height = Application.CentimetersToPoints(0.98)
.Width = Application.CentimetersToPoints(1.98)
End With
End Sub


Regards
Claus B.

 

[Nabeel K]

worked perfect! thanks so much

Hi,

Am Wed, 25 Sep 2013 14:19:11 +0100 schrieb Nabeel K:
-

try:
Sub Pictures2()
Dim sr
ActiveSheet.Shapes.SelectAll
Set sr = Selection.ShapeRange
With sr
.LockAspectRatio = False
.Height = Application.CentimetersToPoints(0.98)
.Width = Application.CentimetersToPoints(1.98)
End With
End Sub


Regards
Claus B.