Erreur 1004: L'lObjet plageformes doit contenir au moins deux éléments

**djibysadji** · 06/08/2024, 06h03

Bonjour
Je veux en cliquant sur la cellule M20 de la feuille "Cours" afficher les icones de la liste des matières. Dans la feuille "Admin" à partir de la ligne 10 il y a en BC les icones, en BD les noms d'icones et en BE le nom du fichier(image). La macro MontreListIcone doit au clic sur la cellule M20 de la feuille Cours(Renommée dans l'éditeur comme Form_Cours) dupliquer la forme nommée IconMenuSample, la regrouper avec l'icone corresponde. Si les explications ne sont pas claires, ci dessous des captures des feuille Cours(surnommée Form_Cours) et Admin et le code. L'erreur se situe au niveau de cette ligne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

With .Shapes.Range(ShapeArr).Group

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub MontreListIcone()
Dim IconRow As Long, LastIconRow As Long
Dim ShapeArr() As String
Dim ShapeGrp As Variant
LastIconRow = Admin.Range("BE39").End(xlUp).Row
If LastIconRow < 10 Then Exit Sub
IconNumb = 1
With Form_Cours
On Error Resume Next
.Shapes("IconMenuGrp").Delete
On Error GoTo 0
For IconRow = 10 To LastIconRow
.Shapes("IconMenuSample").Duplicate.Name = "IconMenu" & IconNumb
With .Shapes("IconMenu" & IconNumb)
.TextFrame2.TextRange.Text = "     " & Admin.Range("BD" & IconRow).Value
If IconNumb <> 1 Then
.Letf = Form_Cours.Shapes("IconMenu" & IconNumb - 1).Left
.Top = Form_Cours.Shapes("IconMenu" & IconNumb - 1).Top + Form_Cours.Shapes("IconMenu" & IconNumb - 1).Height
End If
End With
ShapeGrp = ShapeGrp & "IconMenu" & IconNumb & ","
FilePath = [AppFolder] & "\ClassIcons\" & Admin.Range("BE" & IconRow).Value
If Dir(FilePath, vbDirectory) = "" Then GoTo skipIcon
.Pictures.Insert(FilePath).Name = "IconItem" & IconNumb
With .Shapes("IconItem" & IconNumb)
.LockAspectRatio = msoCTrue
.Height = 12
.Left = Form_Cours.Shapes("IconMenu" & IconNumb).Left + 2
.Top = Form_Cours.Shapes("IconMenu" & IconNumb).Top + 2
.Visible = msoCTrue
End With
ShapeGrp = ShapeGrp & "IconItem" & IconNumb & ","
skipIcon:
IconNumb = IconNumb + 1
ShapeGrp = Left(ShapeGrp, Len(ShapeGrp) - 1)
ShapeArr = Split(ShapeGrp, ",")
With .Shapes.Range(ShapeArr).Group
.Name = "IconMenuGrp"
.Left = Form_Cours.Range("M21").Left
.Top = Form_Cours.Range("M21").Top
.OnAction = "Class_SelectIcon"
End With
Next IconRow
End With
End Sub

**EricDgn** · 24/08/2024, 10h46

Bonjour,

Vous avez sans doute trouvé la solution depuis, mais voici toujours une suggestion:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Option Explicit
 
Sub MontreListIcone()
    Dim IconRow As Long, LastIconRow As Long
    Dim ShapeArr() As String
    Dim ShapeGrp As Variant
    LastIconRow = Admin.Range("BE39").End(xlUp).Row
    If LastIconRow < 10 Then Exit Sub
    iconnumb = 1
    With Form_Cours
        On Error Resume Next
        .Shapes("IconMenuGrp").Delete
        On Error GoTo 0
        For IconRow = 10 To LastIconRow
            .Shapes("IconMenuSample").Duplicate.Name = "IconMenu" & iconnumb
            With .Shapes("IconMenu" & iconnumb)
                .TextFrame2.TextRange.Text = "     " & Admin.Range("BD" & IconRow).Value
                If iconnumb <> 1 Then
                    .Letf = Form_Cours.Shapes("IconMenu" & iconnumb - 1).Left
                    .Top = Form_Cours.Shapes("IconMenu" & iconnumb - 1).Top + Form_Cours.Shapes("IconMenu" & iconnumb - 1).Height
                End If
            End With
            ShapeGrp = ShapeGrp & "IconMenu" & iconnumb & ","
            FilePath = [AppFolder] & "\ClassIcons\" & Admin.Range("BE" & IconRow).Value
            If Dir(FilePath, vbDirectory) = "" Then GoTo skipIcon
            With .Shapes("IconItem" & iconnumb)
                .LockAspectRatio = msoCTrue
                .Height = 12
                .Left = Form_Cours.Shapes("IconMenu" & iconnumb).Left + 2
                .Top = Form_Cours.Shapes("IconMenu" & iconnumb).Top + 2
                .Visible = msoCTrue
            End With
            ShapeGrp = ShapeGrp & "IconItem" & iconnumb & ","
skipIcon:
            iconnumb = iconnumb + 1
            ShapeGrp = Left(ShapeGrp, Len(ShapeGrp) - 1)
            ShapeArr = Split(ShapeGrp, ",")
        Next IconRow
        If iconnumb = 1 Then
            MsgBox "Annulé. L'lObjet plageformes doit contenir au moins deux éléments", , "Anomalie"
        Else
            With .Shapes.Range(ShapeArr).Group
                .Name = "IconMenuGrp"
                .Left = Form_Cours.Range("M21").Left
                .Top = Form_Cours.Range("M21").Top
                .OnAction = "Class_SelectIcon"
            End With
        End If
    End With
End Sub

Cordialement.

**djibysadji** · 24/08/2024, 14h25

Envoyé par EricDgn

Bonjour,

Vous avez sans doute trouvé la solution depuis, mais voici toujours une suggestion:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Option Explicit
 
Sub MontreListIcone()
    Dim IconRow As Long, LastIconRow As Long
    Dim ShapeArr() As String
    Dim ShapeGrp As Variant
    LastIconRow = Admin.Range("BE39").End(xlUp).Row
    If LastIconRow < 10 Then Exit Sub
    iconnumb = 1
    With Form_Cours
        On Error Resume Next
        .Shapes("IconMenuGrp").Delete
        On Error GoTo 0
        For IconRow = 10 To LastIconRow
            .Shapes("IconMenuSample").Duplicate.Name = "IconMenu" & iconnumb
            With .Shapes("IconMenu" & iconnumb)
                .TextFrame2.TextRange.Text = "     " & Admin.Range("BD" & IconRow).Value
                If iconnumb <> 1 Then
                    .Letf = Form_Cours.Shapes("IconMenu" & iconnumb - 1).Left
                    .Top = Form_Cours.Shapes("IconMenu" & iconnumb - 1).Top + Form_Cours.Shapes("IconMenu" & iconnumb - 1).Height
                End If
            End With
            ShapeGrp = ShapeGrp & "IconMenu" & iconnumb & ","
            FilePath = [AppFolder] & "\ClassIcons\" & Admin.Range("BE" & IconRow).Value
            If Dir(FilePath, vbDirectory) = "" Then GoTo skipIcon
            With .Shapes("IconItem" & iconnumb)
                .LockAspectRatio = msoCTrue
                .Height = 12
                .Left = Form_Cours.Shapes("IconMenu" & iconnumb).Left + 2
                .Top = Form_Cours.Shapes("IconMenu" & iconnumb).Top + 2
                .Visible = msoCTrue
            End With
            ShapeGrp = ShapeGrp & "IconItem" & iconnumb & ","
skipIcon:
            iconnumb = iconnumb + 1
            ShapeGrp = Left(ShapeGrp, Len(ShapeGrp) - 1)
            ShapeArr = Split(ShapeGrp, ",")
        Next IconRow
        If iconnumb = 1 Then
            MsgBox "Annulé. L'lObjet plageformes doit contenir au moins deux éléments", , "Anomalie"
        Else
            With .Shapes.Range(ShapeArr).Group
                .Name = "IconMenuGrp"
                .Left = Form_Cours.Range("M21").Left
                .Top = Form_Cours.Range("M21").Top
                .OnAction = "Class_SelectIcon"
            End With
        End If
    End With
End Sub

Cordialement.

Bonjour
Votre suggestion marche aussi. Merci beaucoup.

Erreur 1004: L'lObjet plageformes doit contenir au moins deux éléments

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager