Selection.group ne fonctionne pas
Bonjour,
Je cherche à créer la vue aérienne d'une zone avec les différents eubles qui sont dedans (pour voir les aménagements possibles à l'échelle).
J'ai réussi à faire un code qui me sort mes meubles à la bonne échelle mais je n'arrive pas à les grouper pour éviter d'avoir à répéter à chaque fois la manip.
Voilà le code, si quelqu'un peut m'aider.
Sub creer_rack_de_face()
Dim cts As Integer
Dim Rect As Shape
Dim NbRacks As Integer
Dim haut As Long
Dim gauche As Integer
Dim I As Integer
Dim tube As Integer
Dim Tabgroupe() As Variant
ReDim Tabgroupe(1 To 4)
'position, décalage entre 2 rectangles
gauche = 480
haut = 650
cts = 30
tube = 0.29 * cts
'création du nombre de racks indiqués par cellule
NbRacks = Workbooks("Kaizen mise à l'échelle").Sheets("Mise en plan des bacs d'un rack").Cells(1, 10).Value
Workbooks("Kaizen mise à l'échelle").Sheets("Mise en plan des bacs d'un rack").Cells(1, 10).Interior.Color = RGB(200, 12, 12)
For I = 1 To NbRacks
Set Rect = ActiveSheet.Shapes.AddShape(1, 1, 1, 1, 1)
Rect.Name = "rack"
With Rect
.Width = 13 * cts
.Height = 13 * cts
.Left = gauche
.Top = haut
.TextFrame.Characters.Text = "Rack de pièces P00.-..."
.TextFrame.Characters.Font.ColorIndex = 2
.TextFrame2.TextRange.Font.UnderlineStyle = _
msoUnderlineSingleLine
.TextFrame2.TextRange.ParagraphFormat.Alignment = _
msoAlignCenter
.Fill.ForeColor.RGB = RGB(1, 128, 181)
.TextEffect.FontBold = msoCTrue
.TextEffect.FontSize = 15
End With
Set Rect1 = ActiveSheet.Shapes.AddShape(1, 1, 1, 1, 1)
Rect1.Name = "barre1"
With Rect1
.Width = 13 * cts
.Height = tube
.Left = gauche
.Top = haut + Cells(2, 17).Value * cts
.Fill.ForeColor.RGB = RGB(255, 255, 255)
End With
Set Rect2 = ActiveSheet.Shapes.AddShape(1, 1, 1, 1, 1)
Rect2.Name = "barre2"
With Rect2
.Width = 13 * cts
.Height = tube
.Left = gauche
'gauche = gauche + .Width + 2
.Top = haut + (Cells(4, 17).Value * cts + Cells(2, 17).Value * cts) / 10 + tube
.Fill.ForeColor.RGB = RGB(255, 255, 255)
End With
Set Rect3 = ActiveSheet.Shapes.AddShape(1, 1, 1, 1, 1)
Rect3.Name = "barre3"
With Rect3
.Width = 13 * cts
.Height = tube
.Left = gauche
'gauche = gauche + .Width + 2
.Top = haut + (Cells(2, 17).Value * cts + Cells(4, 17).Value * cts + Cells(7, 17).Value * cts) / 10 + 2 * tube
.Fill.ForeColor.RGB = RGB(255, 255, 255)
End With
Set Rect4 = ActiveSheet.Shapes.AddShape(1, 1, 1, 1, 1)
Rect4.Name = "barre4"
With Rect4
.Width = 13 * cts
.Height = tube
.Left = gauche
'gauche = gauche + .Width + 2
.Top = haut + (Cells(4, 17).Value * cts + Cells(7, 17).Value * cts + Cells(2, 17).Value * cts) / 10 + 3 * tube + (Cells(10, 17).Value * cts) / 10
.Fill.ForeColor.RGB = RGB(255, 255, 255)
End With
Set Rect5 = ActiveSheet.Shapes.AddShape(1, 1, 1, 1, 1)
Rect5.Name = "barre5"
With Rect5
.Width = 13 * cts
.Height = tube
.Left = gauche
'gauche = gauche + .Width + 2
.Top = haut + (Cells(4, 17).Value * cts + Cells(7, 17).Value * cts + Cells(2, 17).Value * cts) / 10 + 4 * tube + (Cells(10, 17).Value * cts + Cells(13, 17).Value * cts) / 10
.Fill.ForeColor.RGB = RGB(255, 255, 255)
End With
gauche = gauche + 13 * cts + 10
'je comprends pas why ça ne fonctionne pas ...
Selection.Group
End With
Next I
End Sub
Le lien du fichier