grouper deux zone de texte

[stormless]

Bonjour a tous

je cherche a grouper des zone de texte entre elles en VBA , quelqu'un connait il la methode car l'aide VBA n'est pas tres clair sur le sujet

merci d'avance

[Catrice]

Bonjour,

Qu'entends tu par grouper des zones de texte ?
Tu veux fusionner les 2 textes dans une seule zone de texte ?
C.a.d. copier le texte de la zone1 + le texte de la zone2 dans la zone 1 ?
Si tel est le cas, voir exemple ci-joint.

[stormless]

Bonjour catrice

ci joint en piece joint l'exemple, ce que je veux associer deux objets pour n'en faire qu'un c'est plus simple pour les deplacer

[stormless]

ci joint la piece joint un oubli

[Catrice]

Re,

La piece jointe n'a pas suivi ..

[stormless]

C'est bon maintenant un oubli

Merci de ton aide

@+

[Catrice]

Re,

J'ai mieux compris, j'étais parti sur autre chose.
Voir le fichier joint

[pierrejean]

bonjour stormless

Salut Catrice

j'ai pratiquement la même chose mais en s'affranchissant des noms

(suppose 2 text box seulement )

[stormless]

Re bonjour a tous les deux

deja merci du coup de main
ci joint un extrait du code ou je veux grouper la photo avec l'addtextbox
je suppose que le probleme vient de la ligne

Shapes.Range(Array(p.name, AddTextbox)).Group

il doit y avoir une probleme d'ecriture

ActiveSheet.Shapes.AddTextbox(msoTextOrientationHo rizontal, 520#, -15 + iiii, _
17#, 45#).Select
Selection.Characters.Text = i
With ActiveSheet
Set p = .Pictures.Insert(Application.FileSearch.FoundFiles (i))
.DrawingObjects(p.Name).Left = .Columns("j").Left
.DrawingObjects(p.Name).Top = .Rows(iii).Top
.DrawingObjects(p.Name).Width = .Columns("l").Left - .Columns("j").Left
.DrawingObjects(p.Name).Height = .Rows(iii + 3).Top - .Rows(iii).Top
.DrawingObjects(p.Name).Placement = xlMoveAndSize
.DrawingObjects(p.Name).PrintObject = True

.Shapes.Range(Array(p.name, AddTextbox)).Group

@+

[Catrice]

Re,

Effectivement comme ceci ça ne doit pas fonctionner :
essaye ceci (non testé)

Sub test()
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHo rizontal, 520#, -15 + iiii, 17#, 45#).Name = "MyName"
Selection.Characters.Text = i
With ActiveSheet
Set p = .Pictures.Insert(Application.FileSearch.FoundFiles (i))
.DrawingObjects(p.Name).Left = .Columns("j").Left
.DrawingObjects(p.Name).Top = .Rows(iii).Top
.DrawingObjects(p.Name).Width = .Columns("l").Left - .Columns("j").Left
.DrawingObjects(p.Name).Height = .Rows(iii + 3).Top - .Rows(iii).Top
.DrawingObjects(p.Name).Placement = xlMoveAndSize
.DrawingObjects(p.Name).PrintObject = True

.Shapes.Range(Array(p.Name, "MyName")).Group
End Sub

[pierrejean]

bonjour stormless

sans avoir testé , je te propose:

 
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHo rizontal, 520#, -15 + iiii, _
17#, 45#).Select
Selection.Characters.Text = i
selection.Name="AJOUT"
With ActiveSheet
Set p = .Pictures.Insert(Application.FileSearch.FoundFiles (i))
.DrawingObjects(p.Name).Left = .Columns("j").Left
.DrawingObjects(p.Name).Top = .Rows(iii).Top
.DrawingObjects(p.Name).Width = .Columns("l").Left - .Columns("j").Left
.DrawingObjects(p.Name).Height = .Rows(iii + 3).Top - .Rows(iii).Top
.DrawingObjects(p.Name).Placement = xlMoveAndSize
.DrawingObjects(p.Name).PrintObject = True
 
.Shapes.Range(Array(p.name, "AJOUT")).Group

Arf !!!

avais pas rafraichi !!

Bravo Catrice (peux pas penser merci Catrice sans que mes diverses "coutures" ne fremissent)

[stormless]

re

c'est super, cela fonctionne avec la macro de pierrejean, la macro de catrice se bloque a la premiere addtextbox afin se n'est pas grave c'est sympa d'avoir apporté ton aide

encore merci a tout les deux pour votre aide

@+

[Catrice]

Re,

Effectivement il y avait une ligne à modifier

Sub test()
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHo rizontal, 520#, -15 + iiii, 17#, 45#).Name = "MyName"
ActiveSheet.Shapes("MyName").Characters.Text = i
With ActiveSheet
Set p = .Pictures.Insert(Application.FileSearch.FoundFiles (i))
.DrawingObjects(p.Name).Left = .Columns("j").Left
.DrawingObjects(p.Name).Top = .Rows(iii).Top
.DrawingObjects(p.Name).Width = .Columns("l").Left - .Columns("j").Left
.DrawingObjects(p.Name).Height = .Rows(iii + 3).Top - .Rows(iii).Top
.DrawingObjects(p.Name).Placement = xlMoveAndSize
.DrawingObjects(p.Name).PrintObject = True

.Shapes.Range(Array(p.Name, "MyName")).Group
End Sub