Pictures not being sorted in VBA

[stainless]

I have an excel spreadsheet with more than one worksheet containing
pictures that I sort on text fields. When the first of these is
sorted, the pictures that are anchored to a column are sorted
correctly. However, the second worksheet results in all the rows being
sorted except for the pictures. The code looks almost the same (just
different sort columns) so I am at a loss as to why this would behave
differently.

I add the pictures to the target cells using the following function
for both worksheets:

Sub InsertPicture(PictureFileName As String, TargetCell As Range,
CenterH As Boolean, CenterV As Boolean)


' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As
Double

If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub

If Dir(PictureFileName) = "" Then Exit Sub

' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
' determine positions
With TargetCell
t = .Top
l = .Left
If CenterH Then
w = .Offset(0, 1).Left - .Left
l = l + w / 2 - p.Width / 2
If l < 1 Then l = 1
End If
If CenterV Then
h = .Offset(1, 0).Top - .Top
t = t + h / 2 - p.Height / 2
If t < 1 Then t = 1
End If
End With
' position picture
With p
.Top = t
.Left = l
' .Height = 0.6
' .Width = 0.1
End With
' Selection.ShapeRange.ScaleHeight 0.1, msoFalse,
msoScaleFromTopLeft
Set p = Nothing
End Sub

This has worked on both sheets. Currently, I set the CentreH/CentreV
values to false so that the picture is aligned with the top left hand
corner of the cell,

The successful worksheet sort process is below (the pictures are in
column U) :

Sub Sort_FirstDayCovers()

ActiveWorkbook.Worksheets(cFirstDayCovers).sort.SortFields.Clear
ActiveWorkbook.Worksheets(cFirstDayCovers).sort.SortFields.Add
Key:=Range( _
"G2:G" + CStr(gLastRow)), SortOn:=xlSortOnValues,
Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets(cFirstDayCovers).sort.SortFields.Add
Key:=Range( _
"H2:H" + CStr(gLastRow)), SortOn:=xlSortOnValues,
Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets(cFirstDayCovers).sort
.SetRange Range("A1:IV" + CStr(gLastRow))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub


The code that does not sort the pictures is below (in this case, the
pictures are in column O):

Sub Sort_Stamps()

ActiveWorkbook.Worksheets(cStamps).sort.SortFields.Clear
ActiveWorkbook.Worksheets(cStamps).sort.SortFields.Add
Key:=Range( _
"D2" + CStr(gLastRow)), SortOn:=xlSortOnValues,
Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets(cStamps).sort.SortFields.Add
Key:=Range( _
"E2:E" + CStr(gLastRow)), SortOn:=xlSortOnValues,
Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets(cStamps).sort
.SetRange Range("A1:IV" + CStr(gLastRow))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

Any ideas why the second piece of code is not sorting the picture
cells?

 

[Peter T]

If you want objects to sort with cells firstly the move & size with cells
flag must be set and secondly the object must be contained entirely within a
single cell. That can be done by setting W/H to zero and resetting when
done.

Set p = ActiveSheet.Pictures(1)
w = p.Width
h = p.Height
p.Width = 0
p.Height = 0

do sort stuff
p.Width = w
p.Height = h

If you've got a lot of pictures, store and reset an array of W/H
i = 0
redim arr(1 to activesheet.pictures.count, 0 to 1) as single
for each p in activesheet.pictures
i = i + 1
with p
arr(i,0) = .width
arr(i,1) = .height

One more thing, the object's topleftcell must be within the sort range, I
can't from your code if that's the case

Excuse air code!

Regards,
Peter T

 

[stainless]

Thanks a lot.

That has worked (once I worked out the Move and Replace bit... )