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

Signaler
Messages postés
13
Date d'inscription
lundi 10 janvier 2011
Statut
Membre
Dernière intervention
12 janvier 2011
-
8e8e
Messages postés
13
Date d'inscription
lundi 10 janvier 2011
Statut
Membre
Dernière intervention
12 janvier 2011
-
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

22 réponses

Messages postés
1839
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
9
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+
Messages postés
1839
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
9
Salut,

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

A+
Messages postés
13
Date d'inscription
lundi 10 janvier 2011
Statut
Membre
Dernière intervention
12 janvier 2011

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 ?).
Messages postés
672
Date d'inscription
mercredi 22 janvier 2003
Statut
Membre
Dernière intervention
2 juin 2016
1
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
Messages postés
13
Date d'inscription
lundi 10 janvier 2011
Statut
Membre
Dernière intervention
12 janvier 2011

ç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...
Messages postés
672
Date d'inscription
mercredi 22 janvier 2003
Statut
Membre
Dernière intervention
2 juin 2016
1
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
Messages postés
13
Date d'inscription
lundi 10 janvier 2011
Statut
Membre
Dernière intervention
12 janvier 2011

ça supprime le signet mais laisse le texte.
Messages postés
1839
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
9
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+
Messages postés
1839
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
9
re

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

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


A+
Messages postés
13
Date d'inscription
lundi 10 janvier 2011
Statut
Membre
Dernière intervention
12 janvier 2011

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
Messages postés
13
Date d'inscription
lundi 10 janvier 2011
Statut
Membre
Dernière intervention
12 janvier 2011

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 !!
Messages postés
13
Date d'inscription
lundi 10 janvier 2011
Statut
Membre
Dernière intervention
12 janvier 2011

Je rectifie :

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


Merci !!!!!!
Messages postés
13
Date d'inscription
lundi 10 janvier 2011
Statut
Membre
Dernière intervention
12 janvier 2011

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
Messages postés
13
Date d'inscription
lundi 10 janvier 2011
Statut
Membre
Dernière intervention
12 janvier 2011

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
Messages postés
1839
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
9
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+
Messages postés
1839
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
9
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 ?
Messages postés
13
Date d'inscription
lundi 10 janvier 2011
Statut
Membre
Dernière intervention
12 janvier 2011

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é.
Messages postés
13
Date d'inscription
lundi 10 janvier 2011
Statut
Membre
Dernière intervention
12 janvier 2011

Personne ?
J'approche du but. Ca fait longtemps que je cherchais une solution. Je suis sur la bonne voie... help
Messages postés
1839
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
9
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
Messages postés
13
Date d'inscription
lundi 10 janvier 2011
Statut
Membre
Dernière intervention
12 janvier 2011

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
1 2