VBA Word - Signet et autres codes [Résolu]

8e8e 13 Messages postés lundi 10 janvier 2011Date d'inscription 12 janvier 2011 Dernière intervention - 10 janv. 2011 à 09:49 - Dernière réponse : 8e8e 13 Messages postés lundi 10 janvier 2011Date d'inscription 12 janvier 2011 Dernière intervention
- 12 janv. 2011 à 16:08
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:\temp\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
Afficher la suite 

Votre réponse

22 réponses

bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 10 janv. 2011 à 15:50
+3
Utile
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:\temp\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+
Cette réponse vous a-t-elle aidé ?  
Commenter la réponse de bigfish_le vrai
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 10 janv. 2011 à 11:30
0
Utile
Salut,

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

A+
Commenter la réponse de bigfish_le vrai
8e8e 13 Messages postés lundi 10 janvier 2011Date d'inscription 12 janvier 2011 Dernière intervention - 10 janv. 2011 à 11:44
0
Utile
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 ?).
Commenter la réponse de 8e8e
cs_loulou69 672 Messages postés mercredi 22 janvier 2003Date d'inscription 2 juin 2016 Dernière intervention - 10 janv. 2011 à 12:19
0
Utile
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
Commenter la réponse de cs_loulou69
8e8e 13 Messages postés lundi 10 janvier 2011Date d'inscription 12 janvier 2011 Dernière intervention - 10 janv. 2011 à 13:34
0
Utile
ç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...
Commenter la réponse de 8e8e
cs_loulou69 672 Messages postés mercredi 22 janvier 2003Date d'inscription 2 juin 2016 Dernière intervention - 10 janv. 2011 à 13:44
0
Utile
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
Commenter la réponse de cs_loulou69
8e8e 13 Messages postés lundi 10 janvier 2011Date d'inscription 12 janvier 2011 Dernière intervention - 10 janv. 2011 à 14:18
0
Utile
ça supprime le signet mais laisse le texte.
Commenter la réponse de 8e8e
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 10 janv. 2011 à 15:01
0
Utile
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’à preuve du contraire


A+
Commenter la réponse de bigfish_le vrai
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 10 janv. 2011 à 15:14
0
Utile
re

une petite précision sur l'appel de la sub :

Sub MaMacro()
'...
  Call BookmarkNewValue("S1",xlSh.Cells(1,1))
'...
End Sub


A+
Commenter la réponse de bigfish_le vrai
8e8e 13 Messages postés lundi 10 janvier 2011Date d'inscription 12 janvier 2011 Dernière intervention - 10 janv. 2011 à 15:39
0
Utile
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
Commenter la réponse de 8e8e
8e8e 13 Messages postés lundi 10 janvier 2011Date d'inscription 12 janvier 2011 Dernière intervention - 10 janv. 2011 à 16:15
0
Utile
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:\temp\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:\temp\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 !!
Commenter la réponse de 8e8e
8e8e 13 Messages postés lundi 10 janvier 2011Date d'inscription 12 janvier 2011 Dernière intervention - 10 janv. 2011 à 16:17
0
Utile
Je rectifie :

J'avais mal tapé le code.
Ca a l'air de fonctionner nikel.


Merci !!!!!!
Commenter la réponse de 8e8e
8e8e 13 Messages postés lundi 10 janvier 2011Date d'inscription 12 janvier 2011 Dernière intervention - 10 janv. 2011 à 16:46
0
Utile
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
Commenter la réponse de 8e8e
8e8e 13 Messages postés lundi 10 janvier 2011Date d'inscription 12 janvier 2011 Dernière intervention - 10 janv. 2011 à 16:49
0
Utile
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:\temp\a.xlsx")



Est-il possible de ne pas recopier cette ligne de code en l'intégrant une bonne fois pour toute ?

Merci
Commenter la réponse de 8e8e
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 10 janv. 2011 à 17:04
0
Utile
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:\temp\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’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:\temp\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+
Commenter la réponse de bigfish_le vrai
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 10 janv. 2011 à 17:08
0
Utile
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 ?
Commenter la réponse de bigfish_le vrai
8e8e 13 Messages postés lundi 10 janvier 2011Date d'inscription 12 janvier 2011 Dernière intervention - 10 janv. 2011 à 17:40
0
Utile
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é.
Commenter la réponse de 8e8e
8e8e 13 Messages postés lundi 10 janvier 2011Date d'inscription 12 janvier 2011 Dernière intervention - 11 janv. 2011 à 10:56
0
Utile
Personne ?
J'approche du but. Ca fait longtemps que je cherchais une solution. Je suis sur la bonne voie... help
Commenter la réponse de 8e8e
bigfish_le vrai 1839 Messages postés vendredi 13 mai 2005Date d'inscription 20 novembre 2013 Dernière intervention - 11 janv. 2011 à 11:28
0
Utile
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’insiste elle est AUTONOME, elle se démerde toute seul du moment qu'on lui donne les 2 valeurs attendues !!!

A+ pour la suite
Commenter la réponse de bigfish_le vrai
8e8e 13 Messages postés lundi 10 janvier 2011Date d'inscription 12 janvier 2011 Dernière intervention - 11 janv. 2011 à 11:45
0
Utile
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
Commenter la réponse de 8e8e

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

VBA Word - Signet et autres codes - page 2