VBA Word - Signet et autres codesRésolu

Question

Bonjour,

J'aurais besoin d'un petit d'aide.
Je ne suis pas un pro en VBA... loin de là 

Soit un document excel contenant des données.
Soit un document word récupérant les données contenues dans certaines cellules d'excel via une macro qui s'exécute via un bouton. 

Pour ce faire, j'ai inséré des signets dans le document word. Dans le VBA j'ai inséré le code suivant :
Sub TexteCellule()
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlSh As Excel.Worksheet
Dim sttemp As String
 
Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Open("c:	emp\a.xlsx")
Set xlSh = xlWb.Sheets(1)
 
sttemp = xlSh.Cells(1, 1)
'Trf du contenu de la cellule vers le signet
ActiveDocument.Bookmarks("S1").Range.Text = xlSh.Cells(1, 1)
Debug.Print sttemp
 
xlWb.Close
xlApp.Quit
Set xlWb = Nothing
Set xlApp = Nothing
 
End Sub


La macro remplit sa mission première mais j'aimerais approfondir ce code.
En effet, j'aimerais que quand j'exécute la macro, le texte contenu dans les cellules ne s'ajoute pas au texte apparu lors d'une exécution précédente de la macro mais remplace le texte existant par le nouveau (est ce clair ?).


Merci beaucoup

bigfish_le vrai · Accepted Answer

re,



Sub TexteCellule()
   Dim xlApp As Excel.Application
   Dim xlWb As Excel.Workbook
   Dim xlSh As Excel.Worksheet
   Dim sttemp As String
 
   Set xlApp = New Excel.Application
   Set xlWb = xlApp.Workbooks.Open("c:	emp\a.xlsx")
   Set xlSh = xlWb.Sheets(1)
 
   sttemp = xlSh.Cells(1, 1)
   'Trf du contenu de la cellule vers le signet
   Call BookmarkNewValue("S1",sttemp)
   Debug.Print sttemp
 
   xlWb.Close
   xlApp.Quit
   Set xlWb = Nothing
   Set xlApp = Nothing
 
End Sub
Sub BookmarkNewValue(ByVal NomSignet As String, ByVal NouvelleValeurSignet As String)
    If ActiveDocument.Bookmarks.Exists(NomSignet) Then
        ActiveDocument.Bookmarks(NomSignet).Select
        Selection = NouvelleValeurSignet 'le bug est ici... le remplacement de la valeur supprime le signet
        Selection.Bookmarks.Add Name:=NomSignet, Range:=Selection.Range
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    End If
End Sub

A+

bigfish_le vrai · Answer

Salut,

c'est bien tu nous à dit ce que tu souhaites faire mais ou est-ce que tu bloques ?

A+

8e8e · Answer

Je bloque sur le remplacement du texte du signet.


En effet, j'aimerais que quand j'exécute la macro, le texte contenu dans les cellules ne s'ajoute pas au texte apparu lors d'une exécution précédente de la macro mais remplace le texte existant par le nouveau (est ce clair ?).

cs_loulou69 · Answer

Bonjour

Si le signet existe, le supprimer et le recréer

au lieu de 

ActiveDocument.Bookmarks("S1").Range.Text = xlSh.Cells(1, 1)

Essayer quelque chose comme (non testé)

If ActiveDocument.Bookmarks.Exists("S1") = True Then

ActiveDocument.Bookmarks("S1").Range.Select
Selection.Delete Unit:=wdCharacter, Count:=1
ActiveDocument.Bookmarks.Add "S1", xlSh.Cells(1, 1)

End if

8e8e · Answer

ça ne fonctionne pas.

J'ai un débogage sur :
ActiveDocument.Bookmarks.Add "S1", xlSh.Cells(1, 1)

De plus, quand j'exécute, il m'efface la première lettre du premier mot du paragraphe...

cs_loulou69 · Answer

La collection Bookmarks autorise Delete
Donc essayer 

If ActiveDocument.Bookmarks.Exists("S1") = True Then 
ActiveDocument.Bookmarks("S1").Delete
Dim sVal as String
sVal=xlSh.Cells(1,1)
ActiveDocument.Bookmarks.Add "S1", sVal

End if

8e8e · Answer

ça supprime le signet mais laisse le texte.

bigfish_le vrai · Answer

Re,

ma premiere question n'était pas anodine 

en fait le sujet n'est pas si simple... maintenant que je vous ai laissé patauger un peu voici une solution:

En fait il y a un bug connu de MS sur le remplacement d'une valeur d'un signet :

Sub BookmarkNewValue(ByVal NomSignet As String, ByVal NouvelleValeurSignet As String)
    If ActiveDocument.Bookmarks.Exists(NomSignet) Then
        ActiveDocument.Bookmarks(NomSignet).Select
        Selection = NouvelleValeurSignet 'le bug est ici... le remplacement de la valeur supprime le signet
        Selection.Bookmarks.Add Name:=NomSignet, Range:=Selection.Range
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    End If
End Sub

J'ai essayé beaucoup de méthodes et pour l'instant seul celle-ci fonctionne.

Loulou69, ta méthode ne fonctionne pas car la valeur doit déjà être présente dans le document lors de la création du signet. Sinon cela revient à changer la valeur du signet et on retombe sur le bug... en tout cas jusqu&#8217;à preuve du contraire


A+

bigfish_le vrai · Answer

re

une petite précision sur l'appel de la sub :

Sub MaMacro()
'...
  Call BookmarkNewValue("S1",xlSh.Cells(1,1))
'...
End Sub

A+

8e8e · Answer

Excusez moi mais je ne suis pas très fort en VBA.

Donc je laisse mon code d'origine, je mets le code que vous m'avez donné à la suite et le dernier j'en fais quoi ? Je l'intègre où ?

Merci beaucoup

8e8e · Answer

Alors j'ai fait ça :

Sub TexteCelluleS1()
   Dim xlApp As Excel.Application
   Dim xlWb As Excel.Workbook
   Dim xlSh As Excel.Worksheet
   Dim sttemp As String
 
   Set xlApp = New Excel.Application
   Set xlWb = xlApp.Workbooks.Open("c:	emp\a.xlsx")
   Set xlSh = xlWb.Sheets(1)
 
   sttemp = xlSh.Cells(1, 1)
   'Trf du contenu de la cellule vers le signet
   Call BookmarkNewValue("S1",sttemp)
   Debug.Print sttemp
 
   xlWb.Close
   xlApp.Quit
   Set xlWb = Nothing
   Set xlApp = Nothing
 
End Sub
Sub BookmarkNewValue(ByVal S1 As String, ByVal NouvelleValeurSignet As String)
    If ActiveDocument.Bookmarks.Exists(S1) Then
        ActiveDocument.Bookmarks(S1).Select
        Selection = NouvelleValeurSignet 'le bug est ici... le remplacement de la valeur supprime le signet
        Selection.Bookmarks.Add Name:=S1, Range:=Selection.Range
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    End If
End Sub

________________________________________________________________________

Sub TexteCelluleS2()
   Dim xlApp As Excel.Application
   Dim xlWb As Excel.Workbook
   Dim xlSh As Excel.Worksheet
   Dim sttemp As String
 
   Set xlApp = New Excel.Application
   Set xlWb = xlApp.Workbooks.Open("c:	emp\a.xlsx")
   Set xlSh = xlWb.Sheets(1)
 
   sttemp = xlSh.Cells(2, 1)
   'Trf du contenu de la cellule vers le signet
   Call BookmarkNewValue("S2",sttemp)
   Debug.Print sttemp
 
   xlWb.Close
   xlApp.Quit
   Set xlWb = Nothing
   Set xlApp = Nothing
End Sub

_______________________________________________________________________

Sub BookmarkNewValue(ByVal S2 As String, ByVal NouvelleValeurSignet As String)
    If ActiveDocument.Bookmarks.Exists(S2) Then
        ActiveDocument.Bookmarks(S2).Select
        Selection = NouvelleValeurSignet 'le bug est ici... le remplacement de la valeur supprime le signet
        Selection.Bookmarks.Add Name:=S2, Range:=Selection.Range
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    End If
End Sub

J'ai crée un bouton qui exécute les macros.
Le texte est bien remplacé mais il me supprime le signet S1 et ne me garde que S2 !!

8e8e · Answer

Je rectifie :

J'avais mal tapé le code.
Ca a l'air de fonctionner nikel.


Merci !!!!!!

8e8e · Answer

Demande supplémentaire :

Je voudrais créer une message box qui s'affiche avec le texte suivant :
1 - Si le fichier source a été modifié alors la message box affiche

Attention ! Le fichier source a été changé

2 - Si le fichier source n'a pas été modifié alors la message box affiche :

Aucune modification n'a été apportée au fichier source.

De plus, est-il de recevoir un mail si le fichier a été modifié. Du genre la personne ouvre le fichier, le modifie, l'enregistre, et à la fermeture du fichier un mail est envoyé pour dire que le fichier a été modifié. J'en demande trop ? 

Merci

8e8e · Answer

Autre demande (plus importante que la précédente) :

Je risque d'avoir beaucoup de signets et je remarque que je suis souvent obligé de changer le chemin d'accès

Set xlWb = xlApp.Workbooks.Open("c:	emp\a.xlsx")


Est-il possible de ne pas recopier cette ligne de code en l'intégrant une bonne fois pour toute ?

Merci

bigfish_le vrai · Answer

re,

ah oui mais non ! 

un des avantages de la programmation est de pouvoir répéter une tache fastidieuse sans que ce soit fastidieux justement !

donc :

soit tu appels la sub TexteCellule en lui précisant la valeur à récuperé, valeur par valeur, comme ceci:

(Solution déconseillée car très lente)

Sub MaMacro()'Sub appelante
   Dim Ligne as Integer
   For Ligne=1 to 2 'pour les 2 premieres lignes par exemple
      Call TexteCellule(Ligne)
   Next
End Sub 

Sub TexteCellule(Byval Ligne As Integer)
   Dim xlApp As Excel.Application
   Dim xlWb As Excel.Workbook
   Dim xlSh As Excel.Worksheet
   Dim sttemp As String
 
   Set xlApp = New Excel.Application
   Set xlWb = xlApp.Workbooks.Open("c:	emp\a.xlsx")
   Set xlSh = xlWb.Sheets(1)
 
   sttemp = xlSh.Cells(Ligne, 1)
   'Trf du contenu de la cellule vers le signet
   Call BookmarkNewValue("S" & Ligne,sttemp) 'évidemment si tes signets s'appellent S1, S2, S3 ect
   Debug.Print sttemp
 
   xlWb.Close
   xlApp.Quit
   Set xlWb = Nothing
   Set xlApp = Nothing
 
End Sub
Sub BookmarkNewValue(ByVal NomSignet As String, ByVal NouvelleValeurSignet As String)
    If ActiveDocument.Bookmarks.Exists(NomSignet) Then
        ActiveDocument.Bookmarks(NomSignet).Select
        Selection = NouvelleValeurSignet 'le bug est ici... le remplacement de la valeur supprime le signet
        Selection.Bookmarks.Add Name:=NomSignet, Range:=Selection.Range
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    End If
End Sub

Soit tu profites qu'excel est ouvert pour récupérer toutes les valeurs qui t&#8217;intéressent en direct:

(Solution conseillée)

Sub TexteCellule()
   Dim xlApp As Excel.Application
   Dim xlWb As Excel.Workbook
   Dim xlSh As Excel.Worksheet
   Dim sttemp As String
   Dim Ligne As Integer
 
   Set xlApp = New Excel.Application
   Set xlWb = xlApp.Workbooks.Open("c:	emp\a.xlsx")
   Set xlSh = xlWb.Sheets(1)
 
   For Ligne = 1 To 3 'pour les 3 premières lignes pour l'autre exemple
      sttemp = xlSh.Cells(Ligne, 1)
      'Trf du contenu de la cellule vers le signet
      Call BookmarkNewValue("S" & Ligne, sttemp) 'évidemment si tes signets s'appellent S1, S2, S3 ect
      'Debug.Print sttemp
   Next
 
   xlWb.Close
   xlApp.Quit
   Set xlWb = Nothing
   Set xlApp = Nothing
 
End Sub
Sub BookmarkNewValue(ByVal NomSignet As String, ByVal NouvelleValeurSignet As String)
    If ActiveDocument.Bookmarks.Exists(NomSignet) Then
        ActiveDocument.Bookmarks(NomSignet).Select
        Selection = NouvelleValeurSignet 'le bug est ici... le remplacement de la valeur supprime le signet
        Selection.Bookmarks.Add Name:=NomSignet, Range:=Selection.Range
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    End If
End Sub

A+

bigfish_le vrai · Answer

désolé j'ai pas compris la deuxième demande !


Est-il possible de ne pas recopier cette ligne de code en l'intégrant une bonne fois pour toute ? 


Tu veux dire récupérer des valeurs depuis plusieurs fichiers ?

8e8e · Answer

Je n'ai pas compris les derniers codes proposés.

Je mets un lien vers mes fichiers :
[url]http://www.sendspace.com/file/45jjgy/url
[url]http://www.sendspace.com/file/61veki/url


Je n'ai pas compris comment simplifier le code.


Pour la récupération des valeurs : à chaque fois que j'enverrai le fichier données à une personne je renommerai ce fichier. Et donc, je devrais renommer les chemins d'accès dans le VBA. Je voudrais donc dire à VBA que, pour tous les signets il doit aller chercher les infos dans tel fichier.
Exemple : j'envoie le fichier à A, le fichier données aura pour nom DonnéesA.xls. J'envoie à B, le fichier données aura pour nom DonnéesB.xls.


Merci beaucoup du temps accordé.

8e8e · Answer

Personne ? 
J'approche du but. Ca fait longtemps que je cherchais une solution. Je suis sur la bonne voie... help

bigfish_le vrai · Answer

pffff ! désolé de le dire mais c'est parfois découragent, mais bon...

on reprend (premiere partie):

la sub qui suit doit rester tel quelle 

Sub BookmarkNewValue(ByVal NomSignet As String, ByVal NouvelleValeurSignet As String)
    If ActiveDocument.Bookmarks.Exists(NomSignet) Then
        ActiveDocument.Bookmarks(NomSignet).Select
        Selection = NouvelleValeurSignet 'le bug est ici... le remplacement de la valeur supprime le signet
        Selection.Bookmarks.Add Name:=NomSignet, Range:=Selection.Range
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    End If
End Sub

En effet, "NomSignet" et "NouvelleValeurSignet" sont des variables déclarées en paramètre. Comme toutes variables ces 2 variables (ou paramètres dans ce cas particulier) peuvent recevoir n'importe quelle valeur du moment que la valeur est de même type. Par exemple une variable de type "String" ne peu recevoir qu'une chaîne de caractères.
De plus la sub "BookmarkNewValue" ne peut être appelée que en lui founissant, dans l'ordre, le nom du signet à modifier et la nouvelle valeur du signet car elle attend, pour démarrer, ces 2 parametres.

Exemple d'appel:

Call BookmarkNewValue(numéro,sttemp)

Call BookmarkNewValue(marché,sttemp)

etc

Pour conclure sur cette partie, pas besoin de répéter cette sub autant de fois que tu as de signet. Elle se suffit à elle même pour tout tes signets.
J&#8217;insiste elle est AUTONOME, elle se démerde toute seul du moment qu'on lui donne les 2 valeurs attendues !!!

A+ pour la suite

8e8e · Answer

pffff ! désolé de le dire mais c'est parfois découragent, mais bon... 

Désolé je débute 

Je n'ai pas encore appliqué la solution proposée (ainsi que les explications) mais je vous remercie déjà pour avoir répondu. Je commence à y voir plus clair.

Merci

VBA Word - Signet et autres codes

22 réponses

Votre réponse

Discussions similaires