J'ai 2 formes (shp & shp1) avec la même propriété.Je voulais juste savoir s'il existe un moyen de sélectionner les deux formes (shp.select et shp1.select) afin de ne pas avoir à sélectionner deux fois et attribuer la propriété deux fois. J'ai essayé worksheet.selectall mais cela entraîne une erreur.Je suis juste un débutant dans ces domaines, donc je voulais trouver un moyen de le faire.

Private Sub RUN()
    Dim x As Long, cel As Range, ws As Worksheet, shp As Shape, y As Long, z As Long, orow As Long, ocol As Long, cel0 As Range, shp1 As Shape
    Set ws = ActiveSheet
    orow = 3
    ocol = 3
    y = ws.Range("A4").Value
    z = ws.Range("A5").Value
'number shapes
    Set cel = Range("E6")
    Set cel0 = cel.Offset(orow * (z - 1) + 4, 0)
    For x = 1 To y
        Set shp = ws.Shapes.AddShape(msoShapeOval, cel.Left, cel.Top, cel.Width, cel.Width)
        Set shp1 = ws.Shapes.AddShape(msoShapeOval, cel0.Left, cel0.Top, cel0.Width, cel0.Width)
        shp.Select
         With Selection.ShapeRange
            .Fill.Visible = msoFalse
            With .TextFrame
             .Characters.Text = x
                .Characters.Font.ColorIndex = 3
                .HorizontalAlignment = xlHAlignCenter
                .VerticalAlignment = xlVAlignCenter
            End With
            With .Line
                .Visible = msoTrue
                .ForeColor.RGB = RGB(255, 0, 0)
                .Transparency = 0
            End With
        End With
        shp1.Select
        With Selection.ShapeRange
            .Fill.Visible = msoFalse
            With .TextFrame
             .Characters.Text = x
                .Characters.Font.ColorIndex = 3
                .HorizontalAlignment = xlHAlignCenter
                .VerticalAlignment = xlVAlignCenter
            End With
            With .Line
                .Visible = msoTrue
                .ForeColor.RGB = RGB(255, 0, 0)
                .Transparency = 0
            End With
        End With
        Set cel = cel.Offset(0, ocol)
        Set cel0 = cel0.Offset(0, ocol)
        Next
1
Pramod Pandit 19 avril 2020 à 17:43

2 réponses

Meilleure réponse

Essayez ws.Shapes.SelectAll afin de sélectionner toutes les formes sur la feuille.

Afin de sélectionner deux formes spécifiques, vous pouvez utiliser la méthode suivante:

 Dim sel As ShapeRange
  Set sel = ws.Shapes.Range(Array(ws.Shapes(1).Name, ws.Shapes(2).Name))
  sel.Select

Afin d'utiliser votre manière spécifique (shp & shp1), vous devez les nommer après la création. shp.Name = "xx" et shp1.Name = "yy", puis utilisez-les de la manière suivante:

 Dim sel As ShapeRange
  Set sel = ws.Shapes.Range(Array("xx", "yy"))
   'or
  Set sel = ws.Shapes.Range(Array(shp.Name, shp1.Name))
   sel.Select
   'but they must have different names, in order to be individually identified!

Maintenant, veuillez utiliser le prochain (votre) code adapté capable de faire ce dont vous avez besoin (j'ai compris). Il est commenté dans les domaines pertinents et je pense qu'il est facile d'être compris. N'oubliez pas d'avoir une valeur dans la cellule "A4" ... Le code supprime d'abord les formes existantes, le cas échéant. Si vous n'en avez pas besoin, vous pouvez commenter ces lignes:

Private Sub RUN()
    Dim x As Long, cel As Range, ws As Worksheet, shp As Shape, y As Long, z As Long
    Dim orow As Long, ocol As Long, cel0 As Range, shp1 As Shape
    Dim sel As ShapeRange, sh As Shape 'new declarations

    Set ws = ActiveSheet
    orow = 3: ocol = 3

    y = ws.Range("A4").value
    z = ws.Range("A5").value

    Set cel = Range("E6")
    Set cel0 = cel.Offset(orow * (z - 1) + 4, 0)

    'New: delete all existingn shapes, if any_______________
      ws.Shapes.SelectAll: Selection.Delete
    '_______________________________________________________

    'firstly create all shapes and write their TextFrame text:
    For x = 1 To y
        Set shp = ws.Shapes.AddShape(msoShapeOval, cel.left, cel.top, cel.width, cel.width)
          shp.TextFrame.Characters.text = x
        Set shp1 = ws.Shapes.AddShape(msoShapeOval, cel0.left, cel0.top, cel0.width, cel0.width)
          shp1.TextFrame.Characters.text = x

        Set cel = cel.Offset(0, ocol)
        Set cel0 = cel0.Offset(0, ocol)
    Next x
     'create the shaperange of all existing shapes___
     ws.Shapes.SelectAll
     Set sel = Selection.ShapeRange
     '_______________________________________________
    'Changge what can be done at once (except TextFrame properties)
    With sel
        .Fill.Visible = msoFalse
        With .Line
            .Visible = msoTrue
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
        End With
    End With
    '____________________________________________________________

    'Change TextFrame properties (individually for each shape):
    For Each sh In sel
        With sh.TextFrame
            .Characters.Font.ColorIndex = 3
            .HorizontalAlignment = xlHAlignCenter
            .VerticalAlignment = xlVAlignCenter
        End With
    Next
    '__________________________________________________________
End Sub
1
FaneDuru 20 avril 2020 à 09:40

Boucle à travers la collection de formes

Option Explicit

' Write Shapes Names to the Immediate window (CTRL+G)
Sub ShapesNames()

    Dim ws As Worksheet
    Dim shp As Shape

    Set ws = Worksheets("Sheet1")

    For Each shp In ws.Shapes
        Debug.Print shp.Name
    Next shp

End Sub

' Now add the names you wish to an array (vntSh).
Sub ShapesChangeProperties()

    Dim ws As Worksheet
    Dim shp As Shape
    Dim vntSh As Variant

    Set ws = Worksheets("Sheet1")
    vntSh = Array(ws.Shapes("Oval 10"), ws.Shapes("Oval 16"))

    ' Use For Each to loop through the shapes.
    Dim vnt As Variant
    For Each vnt In vntSh
        Debug.Print vnt.Name
    Next vnt

    ' or:

    ' Use For Next to loop through the shapes.
    Dim i As Long
    For i = 0 To UBound(vntSh)
        Debug.Print vntSh(i).Name
    Next i

End Sub

Appliqué à votre code

Sub ForEach()

    Dim vntSh As Variant
    Dim vnt As Variant
    vntSh = Array(shp, shp1)

    For Each vnt In vntSh
        With vnt
            .Fill.Visible = msoFalse
            With .TextFrame
                .Characters.Text = x
                .Characters.Font.ColorIndex = 3
                .HorizontalAlignment = xlHAlignCenter
                .VerticalAlignment = xlVAlignCenter
            End With
            With .Line
                .Visible = msoTrue
                .ForeColor.RGB = RGB(255, 0, 0)
                .Transparency = 0
            End With
        End With
    Next vnt

End Sub

' or:

Sub ForNext()

    Dim vntSh As Variant
    Dim i As Long
    vntSh = Array(shp, shp1)

    For i = 0 To UBound(vntSh)
        With vntSh(i)
            .Fill.Visible = msoFalse
            With .TextFrame
                .Characters.Text = x
                .Characters.Font.ColorIndex = 3
                .HorizontalAlignment = xlHAlignCenter
                .VerticalAlignment = xlVAlignCenter
            End With
            With .Line
                .Visible = msoTrue
                .ForeColor.RGB = RGB(255, 0, 0)
                .Transparency = 0
            End With
        End With
    Next i

End Sub
1
VBasic2008 19 avril 2020 à 15:48