Vba Enlarge & Resize Image

muhammad susanto

Well-known Member
Joined
Jan 8, 2013
Messages
1,766
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows
hi all..
i have code to enlarge image & resize, the code work properly but i want to adding Msg "Select one picture to enlarge" when running the code:
here this code:
VBA Code:
Dim shp As Shape
    Dim big As Single, small As Single
    Dim shpDouH As Double, shpDouOriH As Double
    big = 1.5
    small = 0.5
    On Error Resume Next
    Set shp = ActiveSheet.Shapes(Application.Caller)
    With shp
        shpDouH = .Height
        .ScaleHeight 1, msoTrue, msoScaleFromTopLeft
        shpDouOriH = .Height
    
        If Round(shpDouH / shpDouOriH, 2) = big Then
            .ScaleHeight small, msoTrue, msoScaleFromTopLeft
            .ScaleWidth small, msoTrue, msoScaleFromTopLeft
            .ZOrder msoSendToBack
        Else
            .ScaleHeight big, msoTrue, msoScaleFromTopLeft
            .ScaleWidth big, msoTrue, msoScaleFromTopLeft
            .ZOrder msoBringToFront
        End If
    End With
End Sub

how to make it?

any help, greatly appreciated..

.sst
 

Some videos you may like

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
VBA Code:
Sub ReSizeImage()
    Dim shp As Shape
    Dim big As Single, small As Single
    Dim shpDouH As Double, shpDouOriH As Double
    big = 1.5
    small = 0.5
'is an image selected?
    On Error Resume Next: Set shp = ActiveSheet.Shapes(Selection.Name): On Error GoTo 0
    If shp Is Nothing Then GoTo Handling
    If shp.Type <> msoPicture Then GoTo Handling
'resize
    With shp
        shpDouH = .Height
        .ScaleHeight 1, msoTrue, msoScaleFromTopLeft
        shpDouOriH = .Height
    
        If Round(shpDouH / shpDouOriH, 2) = big Then
            .ScaleHeight small, msoTrue, msoScaleFromTopLeft
            .ScaleWidth small, msoTrue, msoScaleFromTopLeft
            .ZOrder msoSendToBack
        Else
            .ScaleHeight big, msoTrue, msoScaleFromTopLeft
            .ScaleWidth big, msoTrue, msoScaleFromTopLeft
            .ZOrder msoBringToFront
        End If
    End With
Exit Sub
Handling:
MsgBox "Please select a picture first", vbExclamation, ""
End Sub
 

muhammad susanto

Well-known Member
Joined
Jan 8, 2013
Messages
1,766
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows
hi Yongle, working well....
thank you so much...you're always coming
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
This is not a good English phrase - "you're always coming" - it has a different meaning to what you think!
In future perhaps "Thank you" is enough ;)
 

muhammad susanto

Well-known Member
Joined
Jan 8, 2013
Messages
1,766
Office Version
  1. 2016
  2. 2010
Platform
  1. Windows
This is not a good English phrase - "you're always coming" - it has a different meaning to what you think!
In future perhaps "Thank you" is enough ;)
ok, sorry Yongle, thank you.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,468
Messages
5,596,307
Members
414,052
Latest member
Dual Showman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top