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]

Re : grouper deux zone de texte

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]

Re : grouper deux zone de texte

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]

Re : grouper deux zone de texte

ci joint la piece joint un oubli

 

[Catrice]

Re : grouper deux zone de texte

Re,

La piece jointe n'a pas suivi ..

 

[stormless]

Re : grouper deux zone de texte

C'est bon maintenant un oubli

Merci de ton aide

@+

 

[Catrice]

Re : grouper deux zone de texte

Re,

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

 

[pierrejean]

Re : grouper deux zone de texte

bonjour stormless

Salut Catrice

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

(suppose 2 text box seulement )

 

[stormless]

Re : grouper deux zone de texte

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(msoTextOrientationHorizontal, 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 : grouper deux zone de texte

Re,

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

Sub test()
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 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]

Re : grouper deux zone de texte

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 : grouper deux zone de texte

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 : grouper deux zone de texte

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