lier une textbox à une plage de cellules

[CMoa]

Bonjour le forum
Est-il possible de lier une textbox à une plage de cellules et que dans la propriété linkedcell la valeur de la cellule liée se modifie en fonction du déplacement de la textbox?
Merci à tous ceux qui prendront un peu de leur temps à essayer de répondre.

 

[job75]

Re : lier une textbox à une plage de cellules

Bonjour CMoa,

Cette macro dans le fichier joint :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
TextBox1.Visible = False
If Intersect(ActiveCell, [C5:F27]) Is Nothing Then Exit Sub
With TextBox1
  .Top = ActiveCell.Top
  .Left = ActiveCell.Offset(, 1).Left
  .LinkedCell = ActiveCell.Address
  .Visible = True
End With
End Sub

A+

 

[CMoa]

Re : lier une textbox à une plage de cellules

Merci job75
je joint un fichier pour plus amples explications.
Je ne sais pas si ce que je demande est réalisable ou pas.

 

[job75]

Re : lier une textbox à une plage de cellules

Re,

si je place la textbox (...)

Le déplacement manuel d'un contrôle ActiveX n'est possible qu'en Mode Création (menu VBA Exécution).

Aucune macro ne peut s'exécuter alors.

A+

 

[CMoa]

Re : lier une textbox à une plage de cellules

Re,

si je place la textbox (...)

=> ceci est pour dire que si je déplace la textbox dans la plage;la valeur de la textbox s'affiche dans la cellules de la plage sous la textbox.
Effectivement le déplacement n'est possible qu'en mode création.J'ai omis ce petit détail!!!.
Existe-il un autre moyen d'arriver à ce résultat?Labels ou autres?

 

[job75]

Re : lier une textbox à une plage de cellules

Re,

Fichier (2) avec cette nouvelle macro :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim P As Range, o As OLEObject, x$, nom$
Set P = [F2:I6,H7:I9,F10:I11]
If Intersect(Target, P) Is Nothing Then Exit Sub
Cancel = True
'---au cas où les propriétés LinkedCell ne seraient pas renseignées---
For Each o In OLEObjects
  If TypeName(o.Object) = "TextBox" Then _
    If Not Intersect(o.TopLeftCell, P) Is Nothing Then _
      o.LinkedCell = o.TopLeftCell.Address
Next
'---Déplacement---
1 x = UCase(InputBox("Nom ou numéro de la TextBox à déplacer :", , x))
If x = "" Then Exit Sub
For Each o In OLEObjects
  nom = o.Name
  If nom = x Or nom = "T" & x Then
    o.LinkedCell = "": o.TopLeftCell = ""
    Target = o.Object.Value: o.LinkedCell = Target.Address
    o.Top = Target.Top + 5
    o.Left = Target.Left + 5
    x = Replace(nom, "T", "") 'numéro
    OLEObjects("Label" & x).Top = o.Top
    OLEObjects("Label" & x).Left = o.Left + o.Width
    Exit Sub
  End If
Next
GoTo 1
End Sub

Les TextBoxes sont renommées T1 T2 T3... Et les numéros des Labels associés sont les mêmes.

Bonne soirée.

 

[CMoa]

Re : lier une textbox à une plage de cellules

Merci Job75
c'est une excellente idée.
Je regarde si cela peut s'adapter à mon cas et je reviens ici-même.
Merci et bonne soirée

 

[job75]

Re : lier une textbox à une plage de cellules

Re,

J'ai amélioré la macro du post #6, entre autres il manquait un .Address

Bonne fin de soirée.

 

[CMoa]

Re : lier une textbox à une plage de cellules

Bonjour job75;le forum
merci pour l'amélioration est-il possible de garder la valeur des textbox qoi qu'il arrive?
j'explique:
Si je met les 3 textbox dans la même cellule;2 des 3 gardent leur valeur.J'aimerais que cette valeur ne soit pas modifiée.
Si cela est possible bien sûr.

 

[CMoa]

Re : lier une textbox à une plage de cellules

Si j'ai bien compris il suffisait de supprimer ces 3 parties du code.

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim P As Range, o As OLEObject, x$, nom$
Set P = [F2:I6,H7:I9,F10:I11]
If Intersect(Target, P) Is Nothing Then Exit Sub
Cancel = True
'---au cas où les propriétés LinkedCell ne seraient pas renseignées---
For Each o In OLEObjects
  'If TypeName(o.Object) = "TextBox" Then _
    If Not Intersect(o.TopLeftCell, P) Is Nothing Then _ ' <=Partie du code supprimée
      o.LinkedCell = o.TopLeftCell.Address
Next
'---Déplacement---
1 x = UCase(InputBox("Nom ou numéro de la TextBox à déplacer :", , x))
If x = "" Then Exit Sub
For Each o In OLEObjects
  nom = o.Name
  If nom = x Or nom = "T" & x Then
   ' o.LinkedCell = "":  o.TopLeftCell = ""  '<=Partie du code supprimée
    Target = o.Object.Value:
    'o.LinkedCell = Target.Address      ' <=Partie du code supprimée
    o.Top = Target.Top + 5
    o.Left = Target.Left + 5
    x = Replace(nom, "T", "")  'numéro
    OLEObjects("Label" & x).Top = o.Top
    OLEObjects("Label" & x).Left = o.Left + o.Width
    Exit Sub
  End If
Next
GoTo 1
End Sub

 

[CMoa]

Re : lier une textbox à une plage de cellules

Merci Titiak pour cette proposition qui a aussi son inconvénient:
afin de déplacer la textbox il faut faire un clic droit dessus puis un clic gauche afin de reporter le résultat dans la cellule sinon:
passer par une boucle sur tous les textbox afin de les activer du style for each textbox&i....ou individuellement.
j'aurais aimé déplacer l'objet directement.