VBA Shape.Width ???

bof

XLDnaute Occasionnel
Bonsoir.
Le problème n'est pas simple à expliquer textuellement.
Il s'agit de fixer la largeur d'une shape tout en gardant la possibilité de modifier sa hauteur.

Le problème est très explicite sur la pièce jointe.
Merci,
A+
 

Pièces jointes

  • leprobleme.xlsm
    21.1 KB · Affichages: 37

Papou-net

XLDnaute Barbatruc
Re : VBA Shape.Width ???

Bonsoir bof,

En fixant la propriété Width (comme tu l'évoques dans le titre), ça semble répondre à ta question:

Code:
Sub TBoxMove(k)
With ActiveSheet.DrawingObjects(1)
   .Formula = "=" & [Nom].Address
   .Top = Cells(1).Top
   .Left = Cells(1, k + 2).Left
   .Height = Cells(1).Height * [Nom].Rows.Count
   .Width = 100
End With
Exit Sub
End Sub
Il suffit de changer la valeur 100 pour l'adapter à tes besoins.

Cordialement.
 

Modeste geedee

XLDnaute Barbatruc
Re : VBA Shape.Width ???

Bonsour®
????
Code:
Sub TBoxMove(k)
With ActiveSheet.DrawingObjects(1)
   .Formula = "=" & [Nom].Address
   .Top = Cells(1).Top
   .Left = Cells(1, k + 2).Left
   .Height = Cells(1).Height * [Nom].Rows.Count
   '-------ajustement = largeur (pixels) de la colonne B
   .Width = [C1].Left - [B1].Left
End With
Exit Sub
End Sub
 

bof

XLDnaute Occasionnel
Re : VBA Shape.Width ???

Bonsoir,
Aucune des solutions VBA ne semble convenir :

En règle générale aucune ne résiste à la réinitialisation. (s'il ne reste que B1)
papou-net : ne résiste pas à la réinitialisation.
Modeste : ne s'étend plus en hauteur et ne diminue plus non plus.

J'avais en effet remarqué qu'on ne peut fixer à la fois la hauteur et la largeur car le respect des proportions posait problème.

C'est jpb388 qui déniche la bonne solution !

Merci !

A+
 

Modeste geedee

XLDnaute Barbatruc
Re : VBA Shape.Width ???

Bonsour®
En règle générale aucune ne résiste à la réinitialisation. (s'il ne reste que B1)
Modeste : ne s'étend plus en hauteur et ne diminue plus non plus.
????


J'avais en effet remarqué qu'on ne peut fixer à la fois la hauteur et la largeur car le respect des proportions posait problème.

VB:
Sub TBoxMove(k)
 With ActiveSheet.DrawingObjects(1)
    .ShapeRange.LockAspectRatio = msoFalse '  <<<<<< !!!
    .Formula = "=" & [Nom].Address
    .Top = Cells(1).Top
    .Left = Cells(1, k + 2).Left
    .Height = [Nom].Height
    '-------ajustement = largeur (pixels) de la colonne B
    .Width = [C1].Left - [B1].Left
 End With
 Exit Sub
 End Sub
 

Discussions similaires

Réponses
12
Affichages
329

Statistiques des forums

Discussions
312 304
Messages
2 087 061
Membres
103 447
dernier inscrit
DamD