VBA – Zone de texte et ajustement personnalisé

DoubleZero

XLDnaute Barbatruc
Bonjour à toutes et à tous,

Je souhaiterais obtenir une zone de texte aux dimensions fixe en largeur mais automatique en longueur et... ne parviens pas :( à trouver la syntaxe idoine.

Peut-être est-ce impossible ?

Je vous remercie vivement pour votre aide.

A bientôt :)
 

Pièces jointes

  • 00 - Zone de texte.xls
    35.5 KB · Affichages: 101
Dernière édition:

Modeste geedee

XLDnaute Barbatruc
Re : VBA – Zone de texte et ajustement personnalisé

Bonsour®

:cool:
peut-être avec une zone de texte ActiveX
et en jouant avec les propriétés :
- largeur (width)= x
- WordWrap =true
- Multiline=true
- scrollbarsBoth
- LinkedCell = celluleX

à rafraichir à chaque modification du contenu de la cellule choisie
 

MJ13

XLDnaute Barbatruc
Re : VBA – Zone de texte et ajustement personnalisé

Bonjour 00, Modeste

Tu peux aussi en connaissant la taille du texte, adapter à la longueur du cadre.

Voici un code pour avoir la taille de la zone du texte sélectionné: à voir en fonction de la police la hauteur et la largeur que tu peux définir.

Code:
Sub Zone_de_texte()
    'Dim s As Shape
    'With ActiveCell
        'Set s = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, .Left, .Top, 50, 20)
        's.Select
        With Selection
        MsgBox Len(Selection.Text)
            .AutoSize = False
            .Width = 300
            .Height = 100
            .Name = "Z1"
            .PrintObject = False
        End With
    'End With
End Sub
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : VBA – Zone de texte et ajustement personnalisé

Bonjour à 00 et à tous les autres,

Un autre essai ( pour sans doute Excel >= 2007):
VB:
Sub Zone_de_texte()
Dim s As Shape
  With ActiveCell
    Set s = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, .Left, .Top, 50, 20)
  End With
  s.Name = "Z1"
  s.Select
  With Selection
    .ShapeRange.Width = 453.5433070866
    .ShapeRange.TextFrame2.AutoSize = msoAutoSizeShapeToFitText
    .ShapeRange.TextFrame2.TextRange.Characters.Text = [h1].Value
  End With
  ActiveSheet.Shapes(s.Name).ControlFormat.PrintObject = msoFalse      '
End Sub
 

Pièces jointes

  • 00 - Zone de texte v2.xlsm
    46.6 KB · Affichages: 149
Dernière édition:

david84

XLDnaute Barbatruc
Re : VBA – Zone de texte et ajustement personnalisé

Bonjour tout le monde,
ci-joint un fichier destiné à une autre discussion.
Le double clic dans une cellule comportant du texte fait apparaître la zone de texte.
La modification opérée dans la zone de texte est également opérée dans la cellule sélectionnée.
Vois si cela peut te servir.
A+
 

Pièces jointes

  • Zone texte.xls
    39.5 KB · Affichages: 126
  • Zone texte.xls
    39.5 KB · Affichages: 94
  • Zone texte.xls
    39.5 KB · Affichages: 89

job75

XLDnaute Barbatruc
Re : VBA – Zone de texte et ajustement personnalisé

Bonjour DoubleZero, Modeste, Michel, mapomme, David,

Pourquoi pas une parfaite mise en forme dans une cellule et sa photo :

Code:
Sub PhotoCellule()
Dim largeur, t$
largeur = 83 'largeur de colonne, à adapter
t = "ABUTILON : ses feuilles sont vertes, pointues et dentées. Ses fleurs sont constituées d'un calice renflé à cinq pointes, rouge pourpré et de pétales jaune clair d'où émerge un bouquet d'étamines violet foncé. Les fleurs ont un port tombant. Il est sensible au gel et préfère, en période estivale, les emplacements ombragés."
With Cells(Rows.Count, Columns.Count)
  .ColumnWidth = largeur
  .VerticalAlignment = xlTop
  .HorizontalAlignment = xlJustify 'facultatif
  .Interior.ColorIndex = 24
  .Font.Name = "Calibri"
  .Font.Size = 11
  .WrapText = True
  .Cells = t
  ActiveSheet.DrawingObjects.Delete 'RAZ
  .Copy
  With ActiveSheet.Pictures.Paste 'photo
    .Name = "Z1"
    .PrintObject = False
  End With
  .Delete
End With
With ActiveSheet.UsedRange: End With
End Sub
A+
 

job75

XLDnaute Barbatruc
Re : VBA – Zone de texte et ajustement personnalisé

Re,

Fichier joint avec cette macro dans le code de la feuille :

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
PhotoCellule
Me.Shapes("Z1").Left = ActiveCell.Offset(, 1).Left
End Sub
A+
 

Pièces jointes

  • Photo cellule(1).xls
    60 KB · Affichages: 107

DoubleZero

XLDnaute Barbatruc
Re : VBA – Zone de texte et ajustement personnalisé

Re-bonjour, bonjour, david84 :), job75 :),

@ Modeste geedee :D,

Hélas, je ne parviens pas à mettre les "paroles en musique" :(.

@ MJ13 :D,

Ta macro est parfaite. Selon la taille du texte, il ne me reste plus qu'à adapter, avec la souris, la longueur de la zone de texte. J'ai de la chance car j’ai encore la force de le faire manuellement :eek:.

@ mapomme :D,

Le code est parfait : l'ajustement de "Z1" correspond à mon attente.

@ david84 :D, job75 :D , mapomme :D,

Je « m'en va », au trot, découvrir vos nouvelles merveilles déposées après mon message de 13h23.

D’ores et déjà, 1001 fois merci à chacun et…

… A bientôt :):)

P. S. : Pour Noël, j'ai sollicité un second coffre aux trésors car je commence à avoir quelques difficultés à fermer le premier... déjà bien plein, grâce aux membres bienveillants :eek: !
 

job75

XLDnaute Barbatruc
Re : VBA – Zone de texte et ajustement personnalisé

Re,

Jolis les 3 exemples de mapomme.

Cela vaut le coup de se fatiguer pour mettre les textes en dur dans le code :

Code:
Sub PhotoCellule()
Dim largeur, a, i%
largeur = 83 'largeur de colonne, à adapter
ActiveSheet.DrawingObjects.Delete 'RAZ
If ActiveCell = "" Then End 'arrête toute macro
a = Array("ABUTILON :" & vbLf & vbLf & "Feuille" & vbLf & "Ses feuilles sont vertes, pointues et dentées." & vbLf & vbLf & "Fleur" & vbLf & "Ses fleurs sont constituées d'un calice renflé à cinq pointes, rouge pourpré et de pétales jaune clair d'où émerge un bouquet d'étamines violet foncé. Les fleurs ont un port tombant." & vbLf & vbLf & "Divers" & vbLf & "Il est sensible au gel et préfère, en période estivale, les emplacements ombragés.", _
"PERCE-NEIGE :" & vbLf & "Est une géophyte, c'est à dire que c'est une plante a bulbe, qui passe la majorité de l'année sous cette forme. C'est une vivace herbacée." & vbLf & vbLf & "Feuille" & vbLf & "Il n'y a que deux feuilles assez longues et assez fines, le bout de la feuille ressemble à une spatule de ski. Elles sont d'un vert glauque. Elles peuvent mesurer jusqu'a 20 cm." & vbLf & vbLf & "Tige" & vbLf & "Il n'y a qu'une tige qui porte l'unique fleur, elle dépasse nettement les feuilles, elle a une section ronde." & vbLf & vbLf & "Fleur" & vbLf & "La fleur est solitaire sortant d'une spathe membraneuse, elle est pendante comme une cloche et est formée par six tépales. Trois tépales blancs extérieurs bien visibles et 3 tépales blanc intérieurs très court et tâchés de vert." & vbLf & vbLf & "Odeur" & vbLf & "Plante et fleur sont inodores.", _
"CHEVREFEUILLE DES BOIS :" & vbLf & "Liane vivace de la famille des Caprifoliacées. Ses sarments s'entrelacent et s'étendent jusqu'à plus de 5 mètres. Elle se cultive par boutures. Certaines espèces sont plantées pour leur parfum." & vbLf & vbLf & "Feuille" & vbLf & "Ovales, corriaces, brillantes. Pétiolées à la base et sessiles vers le haut." & vbLf & vbLf & "Tige" & vbLf & "De couleur violette, les tiges s'entrelassent en torches. Elles gagnent en solidité." & vbLf & vbLf & "Fleur" & vbLf & "En boutons elles sont mauve-clair. Le blanc domine par la suite, les organes reproducteurs proéminents. Sont très odorantes. Floraison de juin à octobre." & vbLf & "Attention les fruits sont toxiques." & vbLf & vbLf & "Odeur" & vbLf & "Très odorante.")
For i = 0 To UBound(a)
 If a(i) Like ActiveCell & "*" Then Exit For
Next
If i > UBound(a) Then End 'arrête toute macro
Application.ScreenUpdating = False
With Cells(Rows.Count, Columns.Count)
  .ColumnWidth = largeur
  .VerticalAlignment = xlTop
  '.HorizontalAlignment = xlJustify 'facultatif
  .Interior.ColorIndex = 24
  .Font.Name = "Calibri"
  .Font.Size = 11
  .WrapText = True
  .Cells = a(i)
  .Copy
  With ActiveSheet.Pictures.Paste
    .Name = "Z1"
    .PrintObject = False
  End With
  .Delete
End With
With ActiveSheet.UsedRange: End With
End Sub
Fichier (3).

A+
 

Pièces jointes

  • Photo cellule(3).xls
    72.5 KB · Affichages: 123
Dernière édition:

DoubleZero

XLDnaute Barbatruc
Re : VBA – Zone de texte et ajustement personnalisé

Bonjour, Modeste geedee :), Michel :), mapomme :), David :), job75 :), le Forum,

job75, dois-je changer de mirettes ou bien ai-je encore un souci avec ma version Excel :rolleyes: ?... Je ne vois pas de photo :( !

Vos superbes et différents travaux me seront tous fort utiles :D.

Je vous remercie, chacun :D, très chaleureusement.

A bientôt :):)

P. S. : Pour la petite histoire... j'ai quatre abutilons ;) !
 
Dernière édition:

Discussions similaires

Réponses
2
Affichages
355