XL 2013 Boucle avec des formes

[Noopy123]

Bonjour a tous,

J'aimeras savoir s'il est possible et si c'est le cas, de créer une boucle pour insérer des formes rectangles dans une plage de cellule via VBA
J'aimerais créer un rectangle dans chaque cellule d'une plage allant de la cellule B2 à G8

Merci pour votre aide précieuse

 

[sylvanu]

Si vous sortez de dimensions lignes colonnes, il faut préciser les dimensions.
Voir par ex : https://forum.excel-pratique.com/viewtopic.php?t=77157
L'autre solution plus simple, mais tout dépend de votre but, est de réduire la taille des lignes et colonnes, de façon à rester sur des dimensions de cellules.

 

[Noopy123]

Oui j'aurais préféré avoir à changer les largeurs des cellules mais malheureusement dans mes 6 colonnes il peut y avoir des rectangles de différentes tailles ...Ça m'aurait évité de me prendre la tête et de vous embêter ^^.
Je vais essayer les infos dans le document
Merci beaucoup

 

[Staple1600]

Bonjour le fil, Noopy123, sylvanu

Sorti de mes archives poussières
(Le confinement a cela bien qu'on a le temps du faire du rangement )

Sub Dessiner_Grille()
Dim x%, y%, xDeb%, yDeb%, xFin%, yFin%, shp
x = 0: y = 0
With ActiveSheet
    For x = 0 To 100 Step 10
        xDeb = (x + 0) * 5: yDeb = 500: xFin = xDeb: yFin = 0
        Set shp = .Shapes.AddLine(xDeb, yDeb, xFin, yFin)
        shp.line.ForeColor.RGB = RGB(192, 0, 0)
    Next
    For y = 0 To 100 Step 10
        xDeb = 0: yDeb = (100 - y) * 5: xFin = (0 + 100) * 5: yFin = yDeb
        Set shp = .Shapes.AddLine(xDeb, yDeb, xFin, yFin)
        shp.line.ForeColor.RGB = RGB(192, 0, 0)
    Next
End With
End Sub

En espérant que cela puisse servir ou inspirer ici
(Sinon, cela m'aura permis de ranger mon tiroir à VBA )

 

[Staple1600]

Re

Plus simple
(avec une version bonus )

Sub Encadrez_Moi()
Dim c, shp
If TypeName(Selection) = "Range" Then
With ActiveSheet
    For Each c In Selection
    Set shp = .Shapes.AddTextbox(1, c.Left, c.Top, c.Width, c.Height)
    shp.line.ForeColor.RGB = RGB(192, 0, 0): shp.Fill.ForeColor.ObjectThemeColor = 16
    Next
End With
End If
End Sub
Sub Encadrez_Moi_Version_Fun()
Dim c, shp, vR%, vV%, vB%
Randomize 1600
If TypeName(Selection) = "Range" Then
    With ActiveSheet
    For Each c In Selection
    Set shp = .Shapes.AddTextbox(1, c.Left, c.Top, c.Width, c.Height)
    vR = Application.RandBetween(0, 255): vV = Application.RandBetween(0, 255): vB = Application.RandBetween(0, 255)
    shp.line.ForeColor.RGB = RGB(192, 0, 0): shp.Fill.ForeColor.RGB = RGB(vR, vV, vB)
    Next
    End With
End If
End Sub

Pour tester, sélectionner des cellules (contiguës ou pas) puis lancer la macro de votre choix
(Personnellement, je préfère la seconde: ça égaye le confinement )

 

[_Thierry]

Bravo pour la version Fun...

Ca donne le vertige, mais c'est confinement bon

Merci Staple1600

@+Thierry

 

[_Thierry]

Ca fait des beaux cadres photos !!!

(C'était au concert de Cuba)
LoL @+Thierry

 

[sylvanu]

Staple, le nouveau Mondrian.

 

[Staple1600]

Re, Bonsoir sylvanu

C'est pas moi, c'est le confinement qui m'oblige à ces futilités

Sub Encadrez_Moi_Version_Fun_II()
Dim c, shp, vR%, vV%, vB%
Randomize 1600
If TypeName(Selection) = "Range" Then
    With ActiveSheet
    For Each c In Selection
    Set shp = .Shapes.AddTextbox(1, c.Left, c.Top, c.Width, c.Height)
    shp.line.ForeColor.RGB = RGB(192, 0, 0)
    vR = Application.RandBetween(0, 255): vV = Application.RandBetween(0, 255): vB = Application.RandBetween(0, 255)
    shp.line.ForeColor.RGB = RGB(192, 0, 0)
    shp.Fill.TwoColorGradient Application.RandBetween(1, 5), 1
        With shp.Fill.GradientStops.Item(1).Color
            .RGB = RGB(vR, vV, vB): .TintAndShade = Application.RandBetween(1, 100) / 100
        End With
        With shp.Fill.GradientStops.Item(2).Color
            .RGB = RGB(vR, vV, vB): .TintAndShade = Application.RandBetween(1, 100) / 100
        End With
    shp.Fill.RotateWithObject = msoTrue
    Next
    End With
End If
End Sub
Sub Encadrez_Moi_Version_Fun_III()
Dim c, shp, vR%, vV%, vB%, XX
vPres = Array(20, 8, 21, 22, 4, 6, 1, 9, 10, 18, 19, 5, 2, 15, 11, 3, 7, 14, 12, 16, 17, 24, 23, 13, -2)
Randomize 1600
If TypeName(Selection) = "Range" Then
    With ActiveSheet
    For Each c In Selection
    Set shp = .Shapes.AddTextbox(1, c.Left, c.Top, c.Width, c.Height)
    vR = Application.RandBetween(0, 255): vV = Application.RandBetween(0, 255): vB = Application.RandBetween(0, 255)
    shp.line.ForeColor.RGB = RGB(192, 0, 0)
    shp.Fill.PresetGradient Application.RandBetween(1, 5), 1, vPres(Application.RandBetween(0, 23))
    Next
    End With
End If
End Sub

PS: Très beau tee-shirt , _Thierry.
On reconnait bien le fan des Beatles

 

[_Thierry]

Trop amusant

Encore merci pour ce bon moment !

@+Thierry

 

[Noopy123]

Effectivement ça réveille les pupilles ^^

 

[Noopy123]

Petite question qui n'a rien a voir avec la question précédente mais un peu quand même finalement car je vais solutionner mon problème différemment.
Comment faire pour sélectionner ma colonne active + les 4 suivantes ? J'ai le cerveau en bouillit à forme de chercher comment mettre mes 2 formes cote a cote alors mon cerveau n'arrive plus a réfléchir ^^

 

[Staple1600]

Bonjour le fil

•>Noopy123
Pour ta question; peux-tu déjà expliciter le besoin, stp?
Pour veux-tu recouvrir tes cellules avec une forme (ici un rectangle)
Quel est le contexte réel et la finalité de la chose?

[dernier aparté]
Une dernière pour la route en guise d'invitation
(Invitation à me rejoindre dans le salon pour nous shaper à donf pendant le confinement (bah oui shake your booty, man!
Pour commencer: l'invitation (rejoignez-moi dans le salon)

https://www.excel-downloads.com/thr...es-your-booty-fractales-et-consorts.20043560/

2) La macro

Spoiler: De la Shape avec des bouts de 3D dedans

Sub Encadrez_Moi_Version_Fun_3D()
Dim shp, vR%, vV%, vB%, vPres As Variant
Dim aa%, ab%, ba%, bb%
vPres = Array(20, 8, 21, 22, 4, 6, 1, 9, 10, 18, 19, 5, 2, 15, 11, 3, 7, 14, 12, 16, 17, 24, 23, 13, -2)
Randomize 1600
Application.ScreenUpdating = False
If TypeName(Selection) = "Range" Then
    With ActiveSheet
        For Each c In Selection
        Set shp = .Shapes.AddShape(1, c.Left, c.Top, c.Width, c.Height)
vR = Application.RandBetween(0, 255): vV = Application.RandBetween(0, 255): vB = Application.RandBetween(0, 255)
aa = Application.RandBetween(1, 3): ab = Application.RandBetween(2, 13)
ba = Application.RandBetween(1, 27): bb = Application.RandBetween(1, 9)
         shp.Fill.ForeColor.RGB = RGB(vR, vV, vB)
    With shp.ThreeD
    .BevelTopType = ab: .BevelTopDepth = 5: .BevelTopInset = 8
    .PresetLighting = ba: .PresetLightingSoftness = aa: .PresetLightingDirection = bb
    .ContourColor.RGB = RGB(vR, vV, vB): .ExtrusionColor.RGB = RGB(vR, vV, vB)
    End With
        With shp.Glow
        .Color = RGB(vR, vV, vB): .Transparency = 0.75: .Radius = 7
        End With
    shp.Reflection.Type = 2
    Next
    End With
End If
End Sub

[/dernier aparté]

 

[Noopy123]

Bonjour Staple1600,

L'idée initiale été d'arriver au resultat entouré en rouge ci dessous

C'est à dire de mettre les formes en bleu cote à cote car la largueur est plus grande que la taille d'une cellule. Je voulais que les 5 formes soit alignées sur une largueur de 6 cellules. Mais c'est plus compliqué que je ne le pensais (enfin je n'ai trouvé aucune doc à ce sujet).
Du coup ce que je veux essayer de faire c'est à partir de ma cellule active sélectionner la colonne + les 4 prochaines colonnes, les redimensionner à la taille voulue de mes formes afin que les rectangles soit bien dans les cellules et ne se chevauchent pas.
Ensuite appliquer un format XlFreeFloating et redimensionner mes colonnes à la taille initiale pour que les 5 rectangles soit finalement bien sur 6 cellules.

J’espère avoir été assez clair ^^

 

[Staple1600]

Re

Non, pas clair.
Moi, ce que je cherche à comprendre, c'est la pourquoi de la chose
(cf mon précédent message)

Quel est le contexte réel et la finalité de la chose?

 

[Noopy123]

Le but est d'arriver à la configuration ci-dessous.

L'utilisateur choisira le type de configuration voulu qu'il pourra ajouter à l'infini pour créer un plan en le sélectionnant via un optionbutton

C'est pour cela que je voulais éviter de modifier la tailles des cellules car l’enchaînement est aléatoire en fonction des besoins de l'utilisateur