VBA : Resize 2 Pictures in Specific Range (G13 & D13) Wtih Simultaneously

[muhammad susanto]

hi all..

i found macro code to resize picture in Excel...
here this code :

  [TABLE]
<tbody>[TR]
[TD]Public Sub FitPic()[/TD]
[/TR]
[TR]
[TD]On Error GoTo NOT_SHAPE[/TD]
[/TR]
[TR]
[TD]Dim PicWtoHRatio As Single[/TD]
[/TR]
[TR]
[TD]Dim CellWtoHRatio As Single[/TD]
[/TR]
[TR]
[TD]With Selection[/TD]
[/TR]
[TR]
[TD]PicWtoHRatio = .Width / .Height[/TD]
[/TR]
[TR]
[TD]End With[/TD]
[/TR]
[TR]
[TD]With Selection.TopLeftCell[/TD]
[/TR]
[TR]
[TD]CellWtoHRatio = .Width / .RowHeight[/TD]
[/TR]
[TR]
[TD]End With[/TD]
[/TR]
[TR]
[TD]Select Case PicWtoHRatio / CellWtoHRatio[/TD]
[/TR]
[TR]
[TD]Case Is > 1[/TD]
[/TR]
[TR]
[TD]With Selection[/TD]
[/TR]
[TR]
[TD].Width = .TopLeftCell.Width[/TD]
[/TR]
[TR]
[TD].Height = .Width / PicWtoHRatio[/TD]
[/TR]
[TR]
[TD]End With[/TD]
[/TR]
[TR]
[TD]Case Else[/TD]
[/TR]
[TR]
[TD]With Selection[/TD]
[/TR]
[TR]
[TD].Height = .TopLeftCell.RowHeight[/TD]
[/TR]
[TR]
[TD].Width = .Height * PicWtoHRatio[/TD]
[/TR]
[TR]
[TD]End With[/TD]
[/TR]
[TR]
[TD]End Select[/TD]
[/TR]
[TR]
[TD]With Selection[/TD]
[/TR]
[TR]
[TD].Top = .TopLeftCell.Top[/TD]
[/TR]
[TR]
[TD].Left = .TopLeftCell.Left[/TD]
[/TR]
[TR]
[TD]End With[/TD]
[/TR]
[TR]
[TD]Exit Sub[/TD]
[/TR]
[TR]
[TD]NOT_SHAPE:[/TD]
[/TR]
[TR]
[TD]MsgBox "Select a picture before   running this macro."[/TD]
[/TR]
[TR]
[TD]End Sub[/TD]
[/TR]
</tbody>[/TABLE]

but have a problem, how to make/modify above code that picture after/have resized ALWAYS placing in cell D13 (pict1) and G13 (pict2) , i mean for 2 pictures resize with simultaneously in one action/click.

i hope someone would help me out.

.sst

 

[muhammad susanto]

bump..

 

[John_w]

The macro at https://www.mrexcel.com/forum/excel...l-size-vba-macro-post5201112.html#post5201112 is a modified version of your macro to resize one or more selected pictures.