Figer position shape lors redimensionnement par VBA

Bonjour à tous,

Je coince un peu sur un problème. J'ai créé une macro qui redimensionne des shapes rectangulaires en fonction de valeurs dans un tableau. J'ai donc deux onglets : une carte contenant les shapes ; un tableau avec en première colonne le nom des shapes et en deuxième colonne la valeur width à appliquer.

Cela fonctionne, sauf que les rectangles se déplacent légèrement vers le haut (et seulement vers le haut) à chaque exécution de la macro :

Position initiale

1kiftim

Position après une quinzaine d'exécutions : les formes convergent vers un même point

ixauqdk

Voici le code :

Sub RectPDL()
Dim Carte As Excel.Worksheet
Dim Base As Excel.Worksheet
Dim LigneTable As Long
Dim Forme As Shape
Dim Taille

' Feuille contenant la carte
Set Carte = ThisWorkbook.Sheets("CTI Pays de Loire")
' Feuille contenant la base de données
Set Base = ThisWorkbook.Sheets("Interface plateau-base")
' Définir les lignes dans la table pour la boucle
For LigneTable = Base.UsedRange.Row + 1 To Base.UsedRange.Row + Base.UsedRange.Rows.Count
    For Each Forme In Carte.Shapes("RectanglesPDL").GroupItems
        ' Si le nom de la forme correspond à la valeur de la 1ère colonne
        If Forme.Name = Base.Cells(LigneTable, 1) Then
        ' Appliquer la valeur
            Taille = Base.Cells(LigneTable, 5).Value
            With Forme
            .Width = Taille
            .Height = 10
            End With
            Exit For
        End If
    Next
Next

End Sub

Que je fige ou non les formes via les propriétaires du groupe ne change rien (ne pas déplacer ou dimensionner les cellules), mais je m'y attendais.

Puis-je inclure une ligne pour figer la position absolue de la forme, ou dois-je inclure dans ma boucle quelque chose de type "je prends la forme 1, j'extrais ses coordonnées actuelles, je la supprime, je la recrée en appliquant les coordonnées x,y avec la nouvelle taille" (ce que je ne sais pas encore faire) ?

edit : précision, je risque d'avoir jusqu'à 800 rectangles à redimensionner

En vous remerciant pour votre aide, car je touche aux limites de mes maigres connaissances en VBA.

Cordialement,

Val

Il me semble que c'est par les commandes left et top que l'on fige les positions. A essayer.

Merci pour la réponse.

Y a-t-il un moyen de l'inclure dans la boucle ? Par exemple en demandant que la position de la shape soit le coin supérieur gauche de la cellule la plus proche de sa position actuelle ?

Je pense que l'introduire après Heigt devrait être bon :

With Forme

.Width = Taille

.Height = 10

End With

Pour les valeurs , il faut faire des essais.


Je pense que 0 et 0 devrait être tout à gauche et en haut. Mais il suffit de faire des essais avec 10, 50, 100 et voir où il se place

Bonsoir

Serait-il possible d'avoir le fichier et d'indiquer ce qu'il faut faire pour voir les formes se déplacer

Et en indiquant exactement ce que tu voudrais

Rechercher des sujets similaires à "figer position shape lors redimensionnement vba"