Positioning pictures in worksheet - excel

Question

Below code count pictures that are pasted (by other macro) as msorectangle shape in excel worksheet and position them in 1 row in specific distance beetween each of them. I need to add another restrctions to positioning and im struggling with coding it. Question is how to upgrade this code if:
If number of pictures is <=6 than 1 row of pictures and set size to h:7,25cm w:4,7cm
If number of pictures is >6 and <=11 then 1 row of pictures with size h:5,9cm w:3,8cm
If number of pictures is =12 than 2 rows with size from 1 point h:7,25cm w:4,7cm.
If number of pictures is >12 than every (7, 13, 19, 25 etc. pic) is starting from next row with size from point nr 2 h:5,9cm w:3,8cm
The list of pictures is dynamic.
Sub Sample2()
Dim shp As Shape, shp2 As Shape
Dim ws As Worksheet
Dim lstShp As Integer
Dim shpLft As Double, shpTop As Double, shpWidth As Double, shpHeight As Double
Dim inBetweenMargin As Double
Dim i As Long
'~~> In betwen margin
inBetweenMargin = 8
Set ws = ThisWorkbook.Worksheets("wk")
With ws
'~~> Get the max shape number(name)
For Each shp In .Shapes
If shp.AutoShapeType = msoShapeRectangle Then
If Val(shp.Name) > 1 And Val(shp.Name) > lstShp Then _
lstShp = Val(shp.Name)
End If
Next
'~~> Loop through the shapes
For i = 1 To lstShp
'~~> This is required in case you delete shape 3
'~~> and have only shapes 1,2,4,5 etc...
On Error Resume Next
Set shp = .Shapes(CStr(i))
'shp2 = first photo
Set shp2 = ws.Shapes("1")
On Error GoTo 0
'~~> position them
If Not shp Is Nothing And shp.AutoShapeType = msoShapeRectangle Then
If shpLft = 0 And shpTop = 0 And shpWidth = 0 Then
shpLft = shp.Left
shpTop = shp.Top
shpWidth = shp.Width
Else
shp.Top = shpTop
shp.Left = shpLft + shpWidth + inBetweenMargin
shpLft = shp.Left
shpWidth = shp.Width
End If
End If
'position picture nr 7 and above in second row
If Val(shp.Name) = 7 Then
shp.Top = shp2.Top + shp2.Height + inBetweenMargin
shp.Left = shp2.Left
shpLft = shp.Left
shpWidth = shp.Width
End If
If Val(shp.Name) >= 8 Then
shp.Top = shp2.Top + shp2.Height + inBetweenMargin
End If
Next i
End With
End Sub

Answer 1

For the 2nd last condition, if the total picture count is 12 then I am safely assuming that you need 6 per line. And for the last condition you want 7 per line. For these two we will use a Counter and then we will do either Counter Mod 6 or Counter Mod 7 for that purpose. You can read about Mod operator in MS KB.
The logic is to reset the .Top and .Left in the next line for the last 2 conditions.We will use a boolean variable for that.
Is this what you are trying?
Option Explicit
Sub Sample()
Dim shp As Shape, shp2 As Shape
Dim ws As Worksheet
Dim lstShp As Integer
Dim shpLft As Single, shpTop As Single, shpWidth As Single, shpHeight As Single
Dim oldLeft As Single, oldTop As Single
Dim inBetweenMargin As Single
Dim i As Long, counter As Long, picCount As Long
Dim nextLine As Boolean, MultipleRows As Boolean
Dim ModByNumber As Long
'~~> In betwen margin
inBetweenMargin = 8
Set ws = ThisWorkbook.Worksheets("Sheet1")
With ws
'~~> Get the max shape number(name)
For Each shp In .Shapes
If shp.AutoShapeType = msoShapeRectangle Then
If Val(shp.Name) > 1 And Val(shp.Name) > lstShp Then _
lstShp = Val(shp.Name)
picCount = picCount + 1
End If
Next
Select Case picCount
Case 1 To 6
'~~> Set your default height and Width
shpHeight = 7.25 * 28.34646 '<~~ Cm to Points
shpWidth = 4.7 * 28.34646 '<~~ Cm to Points
Case 7 To 11
'~~> Set your default height and Width
shpHeight = 5.9 * 28.34646 '<~~ Cm to Points
shpWidth = 3.8 * 28.34646 '<~~ Cm to Points
Case 12
'~~> Set your default height and Width
shpHeight = 7.25 * 28.34646 '<~~ Cm to Points
shpWidth = 4.7 * 28.34646 '<~~ Cm to Points
MultipleRows = True
ModByNumber = 6
Case Is > 12
'~~> Set your default height and Width
shpHeight = 5.9 * 28.34646 '<~~ Cm to Points
shpWidth = 3.8 * 28.34646 '<~~ Cm to Points
MultipleRows = True
ModByNumber = 7
End Select
nextLine = False
'~~> Loop through the shapes
For i = 1 To lstShp
'~~> This is required in case you delete shape 3
'~~> and have only shapes 1,2,4,5 etc...
On Error Resume Next
Set shp = .Shapes(CStr(i))
On Error GoTo 0
'~~> position them
If Not shp Is Nothing Then
If shp.AutoShapeType = msoShapeRectangle Then
If shpLft = 0 And shpTop = 0 Then
shpLft = shp.Left
shpTop = shp.Top
shp.Height = shpHeight
shp.Width = shpWidth
'~~> Storing the top and left for resetting
'~~> when moving to next line
oldTop = shp.Top
oldLeft = shp.Left
counter = counter + 1
Else
shp.Top = shpTop
oldTop = shpTop
If nextLine = True Then
shp.Left = shpLft
nextLine = False
counter = 1
Else
shp.Left = shpLft + shpWidth + inBetweenMargin
counter = counter + 1
End If
shp.Height = shpHeight
shp.Width = shpWidth
shpLft = shp.Left
If MultipleRows = True Then
If counter Mod ModByNumber = 0 Then
shpLft = oldLeft
shpTop = oldTop + shpHeight + inBetweenMargin
nextLine = True
End If
End If
End If
End If
End If
'~~> This is required if there is no shape between 4 and 6.
'~~> 5 gets deleted? Also the reason why we are not using "i Mod 7"
'~~> and using "counter Mod 7"
Set shp = Nothing
Next i
End With
End Sub
Screenshots

Answer 2

If number of pictures is 6 than 1 row and set size to h:7,25cm w:4,7cm
If number of pictures is >7 and <=10 then 1 row of pictures with size h:5,9cm w:3,8cm
If number of pictures is <12 than 2 rows with size from 1 point.
If number of pictures is >12 than every 7 pic is starting from next row with size from point nr 2
So if we take i as the amount of pictures:
We can do some simple calculations to check which condition is met and use Select Case
to identify and assign each of your 4 cases like so:
Select Case i
Case IS >= 12
numberofrows = i \ 7 '(this only gives whole numbers)
Formatting = 2
Case IS > 10
numberofrows = 2
Formatting = 1
Case IS >= 7
numberofrows = 1
Formatting = 2
Case ELSE
numberofrows = 1
Formatting = 1
End Select