VBA: How to crop image in cells of column B and save it in a folder with names from column A cells.

[icesanta]

Hi,

I have Column A with image names and column B with images. How can crop images (Up=0.5 cm , down= 0.6 cm, left = 1 cm, Right 1.5 cm) and save the images in a folder with file names in respective rows. Some cells can be blank in between. I have 1.5 k rows.

 

[Kenneth Hobson]

It is best to use something like WIA or other 3rd party program for such. If you can get WIA, this will help. https://msdn.microsoft.com/en-us/library/ms630819(VS.85).aspx
IrFanView is one I have used in the past which is command line driven for things like that.

 

[icesanta]

Can any body please help me to tune the code to put the cropped image from B to C column to their respective rows.
Then I have another VBA code to extract picture from cells with their names from respective rows.

Sub CropPicture()

    Dim shpCrop As Shape
    Dim sngMemoLeft As Single
    Dim sngMemoTop As Single

    Set shpCrop = ActiveSheet.Shapes(Selection.Name)

    With shpCrop
        sngMemoLeft = .Left
        sngMemoTop = .Top
        With .PictureFormat
            .CropLeft = 10
            .CropTop = 10
            .CropBottom = 10
            .CropRight = 10
        End With
        .Left = sngMemoLeft
        .Top = sngMemoTop
    End With

End Sub

 

[Kenneth Hobson]

Sub CropPicture()
  Dim shpCrop As Shape, s As Shape
  Dim sngMemoLeft As Single
  Dim sngMemoTop As Single
  
  If ActiveSheet.Shapes.Count = 0 Then Exit Sub
  For Each shpCrop In ActiveSheet.Shapes
    With shpCrop
      If .Type <> 13 Then GoTo NextShpCrop  '13=Picture
      If .TopLeftCell.Column <> 2 Then GoTo NextShpCrop
      sngMemoLeft = .TopLeftCell.Offset(, 1).Left
      sngMemoTop = .TopLeftCell.Offset(, 1).Top
      With .PictureFormat
        .CropLeft = 10
        .CropTop = 10
        .CropBottom = 10
        .CropRight =10
      End With
      .Left = sngMemoLeft
      .Top = sngMemoTop
    End With
NextShpCrop:
  Next shpCrop
End Sub

 

[icesanta]

Thank you. But I have grouped two image in each cell and the code is working in only one image.
Can any code work in grouped images in cells.

 

[Kenneth Hobson]

I didn't get that.

I guess you would just do the math and divide the cell width by two. The 2nd image's Left would be the cell's Left plus 1/2 the cell's width.

After the crop, I am not sure things would turn out. I guess the only way I would know for sure is if you shared a file with before and after simple examples. Sites like dropbox.com or such can be used for such.