125ml
10-18-2016, 12:38 PM
Hello!
I am currently working on integrating images for all products in our ERP, so that if I do an extraction of the stock on hand I can easily identify which product is concerned. However, I can only add 1 image per reference, even if there are multiple SKU's.
This means that when I extract an Excel file that has a reference with 8 different colourways for example, I have the same image 8 times.
For this I have already found the solution with the code below that merges all cells that have the same image and deletes 7 out of the 8 images.
So far so good and this code works rather efficiently. However, the images are also too small from the current extraction and I would like to resize all remaining images as well as center them in the newly merged cell. Would anyone be able to help out and advise if it's possible to elegantly include these additional functionalities in the same loop?
Thanks in advance!
Chees,
Reno
Current Code:
Sub Merge_Image_Cells()
Dim i As Long
Dim myLastRow As Long
Application.DisplayAlerts = False
myLastRow = Cells(Rows.Count, "I").End(xlUp).Row
For i = myLastRow To 1 Step -1
If Cells(i, 9) = Cells(i + 1, 9) Then
ActiveSheet.Shapes.Range(Array("Picture " & i)).Select
Selection.Delete
Range(Cells(i, 11), Cells(i + 1, 11)).Merge
End If
Next i
Application.DisplayAlerts = True
'
End Sub
I am currently working on integrating images for all products in our ERP, so that if I do an extraction of the stock on hand I can easily identify which product is concerned. However, I can only add 1 image per reference, even if there are multiple SKU's.
This means that when I extract an Excel file that has a reference with 8 different colourways for example, I have the same image 8 times.
For this I have already found the solution with the code below that merges all cells that have the same image and deletes 7 out of the 8 images.
So far so good and this code works rather efficiently. However, the images are also too small from the current extraction and I would like to resize all remaining images as well as center them in the newly merged cell. Would anyone be able to help out and advise if it's possible to elegantly include these additional functionalities in the same loop?
Thanks in advance!
Chees,
Reno
Current Code:
Sub Merge_Image_Cells()
Dim i As Long
Dim myLastRow As Long
Application.DisplayAlerts = False
myLastRow = Cells(Rows.Count, "I").End(xlUp).Row
For i = myLastRow To 1 Step -1
If Cells(i, 9) = Cells(i + 1, 9) Then
ActiveSheet.Shapes.Range(Array("Picture " & i)).Select
Selection.Delete
Range(Cells(i, 11), Cells(i + 1, 11)).Merge
End If
Next i
Application.DisplayAlerts = True
'
End Sub