Zone texte

[maval]

Bonjour

J'aimerai si possible que lorsque je clic sur une cellule de la colonne "J" que je puisse avoir dans ma zone texte le N° de téléphone comme l'exemple

Merci de votre aide

Cordialement
Maval

 

[JCGL]

Re : Zone texte

Bonjour à tous,

Peux-tu essayer ceci dans un module :

Option Explicit

Sub Forme()
On Error Resume Next
    ActiveCell.Select
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 719.25, 14.25, 192.75, 60).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = ActiveCell.Value
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 14). _
        ParagraphFormat
        .FirstLineIndent = 0
        .Alignment = msoAlignLeft
    End With
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 14).Font
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 28
        .Name = "+mn-lt"
    End With
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 255, 255)
        .Transparency = 0
        .Solid
    End With
    With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
        .Solid
    End With
    Selection.ShapeRange.ShapeStyle = msoShapeStylePreset4
    ActiveCell.Select
End Sub

Et ceci dans le module de la feuille :

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Call Forme
End Sub

A + à tous

 

[maval]

Re : Zone texte

Bonjour JCGL

Et merci d'avoir répondu mais j'ai suivi les consignes et sa ne marche pas, ou alors je n'est pas compris.

@+

Maval

 

[JCGL]

Re : Zone texte

Bonjour à tous,

Peux-tu essayer le fichier joint en double cliquant sur une cellule ?

A + à tous

 

[maval]

Re : Zone texte

Re,

Oui nickel je te remercie, mais apparemment j'ai fait comme toi, alors pourrais tu dire ou je me suis tromper?
Merci d'avance

@+

Maval

 

[JCGL]

Re : Zone texte

Bonjour à tous,

Ton fichier du #3 fonctionne parfaitement...
Tu avais tout bon 🙂

A + à tous

 

[maval]

Re : Zone texte

Re,

Merci et bonne journée

@+
Maval

 

[Gelinotte]

Re : Zone texte

Bonjour JCGL,

De mon côté, j'ai dû faire quelque chose de croche, car je remarque que les zones de texte se superposent à chaque fois qu'il y a double clique.

G

 

[JCGL]

Re : Zone texte

Bonjour à tous,

Tu as entièrement raison. Merci de ton retour.

Insérer dans le code l'effacement des formes :

Sub Forme()
On Error Resume Next
ActiveSheet.DrawingObjects.Delete
ActiveCell.Select

A + à tous

 

[david84]

Re : Zone texte

Bonjour et salut à mon frère poisson,
ci joint ton code épuré (je n'ai rien inventé, c'est le tien !) :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 719.25, 14.25, 192.75, 60).Select
With Selection
    .ShapeRange(1).TextFrame2.TextRange.Characters.Text = Target.Value
    .ShapeRange(1).TextFrame2.TextRange.Characters(1, 14).Font.Size = 28
    .ShapeRange.ShapeStyle = msoShapeStylePreset4
End With
Target.Activate
Cancel = True 'si l'on veut empêcher l'accès en écriture par la cellule
End Sub

Il me semble (a priori) que l'on puisse se contenter de ce qui reste (à moins bien sûr que l'utilisateur ne sélectionne le shape et ne lui apporte d'autres modification).
A+

 

[JCGL]

Re : Zone texte

Bonjour à tous,
Salut mon ami Poisson,

Joli condensé...

Après avoir inséré :

ActiveSheet.DrawingObjects.Delete

A+++
A + à tous

Edition : MaVal : dans le module de la feuille.

 

[Gardien de phare]

Re : Zone texte

Bonjour tous,

Perso, je m'étais contenté de ça :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("J:J")) Is Nothing Then
    ActiveSheet.Shapes.Range(Array("TextBox 1")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Target.Value
End If
End Sub

Ca pose quel problème de ne pas recréer le textbox à chaque fois ?

 

[maval]

Re : Zone texte

Re,

je vous remercie à tous et vous souhaite une bonne journée

Maval

 

[mapomme]

Re : Zone texte

Bonjour à tous,

Une autre (pour le fun) en utilisant la cellule J2 en cellule auxilliaire (tout autre cellule ferait l'affaire) et en affectant la formule =$J$2 à la forme texte.

Le code dans module de Feuil1:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
[J2] = "":  If Target(1, 1).Column = 10 And Target(1, 1).Row > 2 Then [J2] = Target(1, 1)
End Sub

 

[maval]

Re : Zone texte

Bonjour Mapomme,

Je te remercie et souhaite une bonne journée

Maval