Sub EssaiGroupage()
GroupeImages Range("B7:C17"), "Groupe1"
GroupeImages Range("E7:F17"), "Groupe2"
End Sub
Sub GroupeImages(champ As Range, NomGroupe)
Dim a()
n = 0
For Each s In ActiveSheet.Shapes
If Not Intersect(Range(s.TopLeftCell.Address), champ) Is Nothing Then
n = n + 1: ReDim Preserve a(1 To n)
a(n) = s.Name
End If
Next
ActiveSheet.Shapes.Range(a).Group.Name = NomGroupe
End Sub
Sub degroupage()
ActiveSheet.Shapes("groupe1").Ungroup
ActiveSheet.Shapes("groupe2").Ungroup
End Sub