XL 2016 Exportation d'une succession de texte vers un seul signet word ?

bilbinou

XLDnaute Nouveau
Bonjour à tous !

Je voulais savoir s'il était possible d'exporter successivement le contenu d'une TextBox vers un signet Word.

J'expose mon problème: j'ai un bouton de commande qui me permet d'exporter le contenu d'une TextBox dans un document Word déjà ouvert vers un signet se trouvant à un endroit précis du document.
Le code : Word.ActiveDocument.Bookmarks ("signet1").Range = TextBox1.Value me permet de faire cette envoi.
Néanmoins, après cette première exportation, le contenu de la TextBox1 change par la suite pour proposer un autre texte. J'aimerai que lorsque l'on appuie de nouveau sur le bouton de commande, le nouveau texte envoyé vienne s'insérer en dessous du texte qui a été exporté avant (et ceci pour plusieurs textes).

Faut-il faire une incrémentation de signet et donc avoir plusieurs signets de type : signet1, signet2, signet3 dans le document word ou existe-t-il une méthode qui permet de ne pas avoir à créer plusieurs signets ? (peut-être un seul signet où on viendrait copier le range, exporter le texte puis coller ce range en dessous du texte ? De cette façon on garderai le même nom pour le signet ... je ne sais pas si ce que je propose est possible).

Je remercie d'avance ceux qui pourront m'apporter une réponse !

PS : si j'ai mal exposé mon problème et qu'il faut le classeur ou des captures d'écran, n'hésitez pas à me le signaler :)
 
Solution
Bonjour bilbinou, le forum,

Concernant l'activation de Word voyez ce fichier (3) :
VB:
Sub Remplacer()
Dim nom As String, texte As String, Wapp As Object, deb As Long
nom = "toto" 'nom du signet Word, à adapter
texte = Trim(Replace(TextBox1, vbCrLf, vbLf)) 'texte à ajouter
If texte = "" Then Exit Sub
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Err Then MsgBox "Ouvrez le document Word !", 48: Exit Sub
Wapp.Visible = True
With Wapp.ActiveDocument
    If .Path <> "" Then ThisWorkbook.FollowHyperlink .FullName 'force l'activation de Word
    deb = .Bookmarks(nom).Start 'début du signet
    If Err Then MsgBox "Le signet n'existe pas !", 48: GoTo 1
    texte = .Bookmarks(nom).Range.Text & vbLf & texte & vbLf...

job75

XLDnaute Barbatruc
Bonsoir bilbinou,

Sur Word quand on entre [Edit] colle un texte sur un signet le signet est supprimé.

Il faut donc le recréer à l'endroit adéquat pour pouvoir s'en servir de nouveau.

Cherchez comment procéder sur le web.

A+
 
Dernière édition:

bilbinou

XLDnaute Nouveau
Bonsoir bilbinou,

Sur Word quand on entre [Edit] colle un texte sur un signet le signet est supprimé.

Il faut donc le recréer à l'endroit adéquat pour pouvoir s'en servir de nouveau.

Cherchez comment procéder sur le web.

A+
Bonjour Job75,

Merci de m'avoir répondu. En effet, j'avais déjà regardé un long moment sur le web pour essayer de trouver réponse à mon problème. N'ayant pas trouvé, c'est pour cette raison que j'ai créée ce post.
J'avais déjà trouvé et testé ce genre de code :

Sub Remplacer(signet As Bookmark, LeMot As String)
Dim deb As Integer, fin As Integer, Nom As String
deb = signet.Start 'début du signet
fin = signet.End 'fin du signet
Nom = signet.Name 'nom du signet
signet.Range.Text = TextBox1.Value 'remplace le texte contenu
With ActiveDocument.Range(Start:=deb, End:=fin) 'emplacement du signet
.Bookmarks.Add Name:=Nom 'ajoute le signet
End With
End Sub

Mais il permet de ne pas détruire le signet et le laisse à l'emplacement du texte préalablement exporté. J'aimerai que lorsque que l'on fait une première exportation, le signet vienne se placer en dessous du texte exporté avec le même nom. Je suppose que l'architecture du code doit être plus ou moins identique à celle présentée ci-dessus mais je n'arrive pas à trouver la subtilité avec le Start, end, (et certainement le retour à la ligne ... ).

Merci vous d'avoir pris du temps pour me répondre
 

job75

XLDnaute Barbatruc
Bonjour bilbinou, le forum,

La macro à placer dans le document Word pour tester :
VB:
Sub Remplacer()
Dim nom As String, texte As String, deb As Long
nom = "toto" 'nom du signet, à adapter
texte = "zzz" 'texte à ajouter
With ActiveDocument
    deb = .Bookmarks(nom).Start 'début du signet
    texte = .Bookmarks(nom).Range.Text & vbLf & texte & vbLf 'encadrement par des renvois à la ligne
    .Bookmarks(nom).Range.Text = texte 'remplace le texte contenu
    .Bookmarks.Add nom, .Range(deb, deb + Len(texte) - 1) 'recrée le signet
End With
End Sub
Dans la feuille Excel contenant TextBox1 on utilisera :
Code:
Sub Remplacer()
Dim nom As String, texte As String, Wapp As Object, deb As Long
nom = "toto" 'nom du signet Word, à adapter
texte = Trim(TextBox1) 'texte à ajouter
If texte = "" Then Exit Sub
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Err Then MsgBox "Ouvrez le document Word !", 48: Exit Sub
Wapp.Visible = True
With Wapp.ActiveDocument
    deb = .Bookmarks(nom).Start 'début du signet
    If Err Then MsgBox "Le signet n'existe pas !", 48: GoTo 1
    texte = .Bookmarks(nom).Range.Text & vbLf & texte & vbLf 'encadrement par des renvois à la ligne
    .Bookmarks(nom).Range.Text = texte 'remplace le texte contenu
    .Bookmarks.Add nom, .Range(deb, deb + Len(texte) - 1) 'recrée le signet
End With
1 AppActivate Wapp.Caption 'activation facultative
End Sub
A+
 

bilbinou

XLDnaute Nouveau
Bonjour bilbinou, le forum,

La macro à placer dans le document Word pour tester :
VB:
Sub Remplacer()
Dim nom As String, texte As String, deb As Long
nom = "toto" 'nom du signet, à adapter
texte = "zzz" 'texte à ajouter
With ActiveDocument
    deb = .Bookmarks(nom).Start 'début du signet
    texte = .Bookmarks(nom).Range.Text & vbLf & texte & vbLf 'encadrement par des renvois à la ligne
    .Bookmarks(nom).Range.Text = texte 'remplace le texte contenu
    .Bookmarks.Add nom, .Range(deb, deb + Len(texte) - 1) 'recrée le signet
End With
End Sub
Dans la feuille Excel contenant TextBox1 on utilisera :
Code:
Sub Remplacer()
Dim nom As String, texte As String, Wapp As Object, deb As Long
nom = "toto" 'nom du signet Word, à adapter
texte = Trim(TextBox1) 'texte à ajouter
If texte = "" Then Exit Sub
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Err Then MsgBox "Ouvrez le document Word !", 48: Exit Sub
Wapp.Visible = True
With Wapp.ActiveDocument
    deb = .Bookmarks(nom).Start 'début du signet
    If Err Then MsgBox "Le signet n'existe pas !", 48: GoTo 1
    texte = .Bookmarks(nom).Range.Text & vbLf & texte & vbLf 'encadrement par des renvois à la ligne
    .Bookmarks(nom).Range.Text = texte 'remplace le texte contenu
    .Bookmarks.Add nom, .Range(deb, deb + Len(texte) - 1) 'recrée le signet
End With
1 AppActivate Wapp.Caption 'activation facultative
End Sub
A+
Bonjour job75,

Merci de votre réponse rapide comme à son habitude.

J'ai essayé votre code et il marche en partie. La première exportation se fait bien à l'emplacement du signet. Mais le nouveau signet créée ne se trouve pas juste en dessous du premier paragraphe envoyé ... Il apparait en effet plus bas dans mon document word, sur une autre page (dans un titre précisément) ce qui induit à l'exportation suivante, une non-continuité du texte (et une coupure du titre)

J'ai alors testé plusieurs choses en essayant notamment de jouer sur la partie : .bookmarks.Add nom (deb,deb + Len(texte)-1) mais rien n'y fait. Je n'arrive pas à le placer juste en-dessous du paragraphe exporté. Pour une raison que j'ignore, il se place plus loin dans mon document.

Remarque: si je veux placer le signet en-dessous du texte exporté, il faut pas que ce nouveau signet soit à un range de : deb+len(texte) , deb + len(texte) +1 ?
 

bilbinou

XLDnaute Nouveau
Bonjour,

Je crois avoir trouvé une explication à mon problème (mais toujours pas de solution). Les textes exportés vers le signet Word contiennent des retour à la ligne ainsi que des espaces. C'est peut-être pour cette raison que le nouveau signet créée se situe plus loin dans le document word que juste en dessous du premier texte exporté...
 

bilbinou

XLDnaute Nouveau
Je ne sais pas pourquoi, chez moi l'instruction AppActivate Wapp.Caption n'a pas d'effet.

Alors qu'elle fonctionnait bien avec des documents non enregistrés.
Chez moi aussi elle n'a pas d'effet ...
J'ai remplacé le text contenu dans la textBox par un texte plus conséquent qui présente des retour à la lignes.
Quand je l'exporte vers word, la macro ne recréée pas de signet ? Avez-vous une explication à cela ?
 

Pièces jointes

  • Fichier Excel(1).xlsm
    23.4 KB · Affichages: 2

job75

XLDnaute Barbatruc
Chez moi aussi elle n'a pas d'effet ...
J'ai remplacé le text contenu dans la textBox par un texte plus conséquent qui présente des retour à la lignes.
Quand je l'exporte vers word, la macro ne recréée pas de signet ? Avez-vous une explication à cela ?
Chez moi pas de problème, le texte de la TextBox avec les retours à la ligne s'insère bien où il faut.

Et en plus Word s'affiche !
 

job75

XLDnaute Barbatruc
Le problème vient du fait que dans une TextBox les renvois à la ligne sont dus à un caractère double vbCrLf c'est à dire CAR(10)&CAR(13).

Pour entrer le texte dans Word il faut le remplacer par le caractère unique vbLf c'est à dire CAR(10).

Voyez le fichier (2) :
VB:
Sub Remplacer()
Dim nom As String, texte As String, Wapp As Object, deb As Long
nom = "toto" 'nom du signet Word, à adapter
texte = Trim(Replace(TextBox1, vbCrLf, vbLf)) 'texte à ajouter
If texte = "" Then Exit Sub
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Err Then MsgBox "Ouvrez le document Word !", 48: Exit Sub
Wapp.Visible = True
With Wapp.ActiveDocument
    deb = .Bookmarks(nom).Start 'début du signet
    If Err Then MsgBox "Le signet n'existe pas !", 48: GoTo 1
    texte = .Bookmarks(nom).Range.Text & vbLf & texte & vbLf 'encadrement par des renvois à la ligne
    .Bookmarks(nom).Range.Text = texte 'remplace le texte contenu
    .Bookmarks.Add nom, .Range(deb, deb + Len(texte) - 1) 'recrée le signet
End With
1 AppActivate Wapp.Caption 'activation facultative
End Sub
 

Pièces jointes

  • Fichier Excel(2).xlsm
    25 KB · Affichages: 3
  • Doc Word.docx
    11.7 KB · Affichages: 3

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T