Crop / move Image Macro

[DWatPerry]

Hi all,

I have a macro below that inserts an image from my C drive into an excel sheet an although this works nicely for what I need, I now need to get it to crop and move back to the right place when it has been cropped. does anyone know what i need to add to the code to get this to work?

Sub test()


Dim picture As Object
Dim address As String
Dim x As Integer
Dim y As Integer
Dim a As Integer
Dim b As Integer

address = Range("JPEG")
x = Range("X7:Z7").Width
y = Range("X7:X72").Height
 



Range("AA7").Select

   With ActiveSheet.Pictures.Insert(address)
    
   .Left = Range("X7:z78").Left
        .Top = Range("X7:z78").Top
        .Width = Range("X7:z78").Width
        .Height = Range("X7:Z78").Height
***

End With

        
  
   'a = picture.ShapeRange.Width
   'b = picture.ShapeRange.Height
   'picture.ShapeRange.LockAspectRatio = msoTrue
  'If a > b Then
   'picture.ShapeRange.Width = x
      
  'Else
  'picture.ShapeRange.Height = y
      
    
'End If

'picture.ShapeRange.Rotation = 0#
'picture.ShapeRange.IncrementLeft (x - picture.ShapeRange.Width) / 2
'picture.ShapeRange.IncrementTop (y - picture.ShapeRange.Height) / 2

End Sub

 

[DWatPerry]

Anyone who needs a macro that inserts an image, puts it in the right place, then crops it, then copies another image from another page and places it where needed then this is the Macro for you!

took me 2 days to get this together and i know its not perfect, but it works!

Sub Auto_Open()
   
 
    
Dim picture As Object
Dim address As String
Dim x As Integer
Dim y As Integer
Dim a As Integer
Dim b As Integer
    
address = Range("JPEG")
x = Range("X7:Z7").Width
y = Range("X7:X72").Height
    
    
    
    
Range("AA7").Select
    
   With ActiveSheet.Pictures.Insert(address)
        
   .Left = Range("X7:z78").Left
        .Top = Range("X7:z78").Top
        .Width = Range("X7:z78").Width
        .Height = Range("X7:Z78").Height
    
    
End With
    
            
Dim shp As Shape
Dim sngMemoLeft As Single
Dim sngMemoTop As Single
Dim i As Integer
i = 0
For Each shp In ActiveSheet.Shapes
With shp
' Insert Shape Type Check (Check in Watches Window)
' If shape is picture, then Type = 13
' If shape is WordArt, then Type = 15
'... etc
' Eg: If Shape is comment (Type = 4)
' it will generate error.
If .Type = 13 Then
sngMemoLeft = .Left
sngMemoTop = .Top
With .PictureFormat
.CropLeft = 200
.CropTop = 40
.CropBottom = 60
.CropRight = 300
End With
.Left = sngMemoLeft
.Top = sngMemoTop
End If
End With
Next

 Sheets("Rip Sheet").Select
    Selection.Copy
    Sheets("Generator").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("Z20").Select
End Sub