Sub Grille_POUR_TEST_II()
Dim c As Range, m As Range, Grille As Range, shp As Shape
If TypeName(Selection) = "Range" Then
Set Grille = Selection.Item(1).Resize(6, 6)
Grille.RowHeight = 50: Grille.ColumnWidth = 4.86
Grille(6, 4).Resize(, 3).Merge: Grille(4, 1).Resize(, 2).Merge
Grille(4, 3).Resize(, 2).Merge: Grille(4, 5).Resize(, 2).Merge
Grille(6, 1).Resize(, 3).Merge: Grille(2, 2).Resize(, 2).Merge
With ActiveSheet
For Each c In Grille
If c.MergeCells Then
Set m = c(1).MergeArea
Set shp = .Shapes.AddShape(1, m.Left, m.Top, m.Width, m.Height)
shp.Line.ForeColor.RGB = RGB(192, 0, 0): shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
Else
Set shp = .Shapes.AddShape(1, c.Left, c.Top, c.Width, c.Height)
shp.Line.ForeColor.RGB = RGB(192, 0, 0): shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
End If
shp.Name = "img_" & shp.ZOrderPosition
shp.OnAction = "Test"
Next
End With
End If
End Sub
Sub Test()
Pict = Application.GetOpenFilename("Fichiers Images ,*.gif;*.jpg;*.png")
If Pict <> False Then
ActiveSheet.Shapes(Application.Caller).Fill.UserPicture Pict
End If
End Sub