[Resolu] [VBA] Macro bibliographie sous word

Macro bibliographie sous word [Resolu] [VBA] - VB/VBA/VBS - Programmation

Marsh Posté le 11-05-2007 à 12:07:56    

Bonjour à tous,
 
je pose le problème :
 
je souhaiterais créer une macro qui me permettrait d'utiliser une bibliographie que j'aurai faite sous excel
 
Pourquoi me direz vous :
- je n'utilise aps LaTeX pour ceux qui connaisse (cadre d'un stage, il me faut un format universel, et LaTeX en est pas un...)
- ordi d'entreprise, je ne peux pas installer EndNote
- j'utilise une version de word largement antérieur à W2007 (1997 pour le coup)
 
j'ai une idée de l'algo, mais je ne sais pas trop comment le mettre en oeuvre sous une macro fonctionnant sous word.
 
je pensais engros faire le fichier excel avec n°,auteur, titre, année,..., raccourci du genre fh.fr pour forum.hardware .fr
ensuite dans excel, je tape \ref{fh.fr}, et lorsque je lance la macro il me remplace ça par le n° associé dans la bilibo sous excel.
 
se pose 2 pb (au moins)
- je pensais faire un replace mais j'arrive pas à accéder à mon fichier excel depuis word (workbooks("biblio.xls" )... ne marche pas)
- comment sauvegardé \ref{...} à chaque fois pour permettre la maj
 
pour la deuxième je pensais sauvegardé le word dans un autre nom. genre on travaille dans nomdefichier.doc, puis on lance macro et il crée nomdefichier-biblio.doc, avec pourquoi pas en plus une copie du fichier biblio.xls à la fin de mon word
 
peut-être qu'une solution serait de partir depuis le fichier excel plutôt que depuis le word, à voir
 
bref siquelqu'un a une idée et un début de piste, ça m'arrangerait bien
 
Merci à tous et à +
 
benj

Message cité 1 fois
Message édité par merenptah44 le 28-05-2007 à 15:53:32
Reply

Marsh Posté le 11-05-2007 à 12:07:56   

Reply

Marsh Posté le 11-05-2007 à 15:00:30    

peux-tu nous montrer le code utilisé actuellement, on doit pouvoir t'aider en partant de la :)

Message cité 1 fois
Reply

Marsh Posté le 11-05-2007 à 15:21:19    

jpcheck a écrit :

peux-tu nous montrer le code utilisé actuellement, on doit pouvoir t'aider en partant de la :)


le problème est l'absence de code puis que je sias ce que je veux faire mais pas comment, disons que :
1- j'ouvre

Code :
  1. Sub main()
  2. Dim fichierdoc As String
  3. fichierdoc = Cells(1, 1).Value
  4. open_word (fichierdoc)
  5. pilot_word (fichierdoc)
  6. replace()
  7. copybiblio()
  8. save-doc(fichierdoc.value(1,Len(fichierdoc)-4 & "-biliboadded)
  9. End Sub
  10. ''
  11. Sub create_word()
  12. Dim WordApp As Word.Application
  13. Dim WordDoc As Word.Document
  15. Set WordApp = CreateObject("Word.Application" )     '-- ouvre une session Word
  16.     WordApp.Visible = True
  17.     Set WordDoc = WordApp.Documents.Add    '-- crée un nouveau document
  18.     WordDoc.SaveAs "C:\monDocument.doc"    '-- enregistre le nouveau doc
  19. End Sub
  20. Sub open_word(fichier As String)
  21. Dim WordApp As Word.Application
  22. Dim WordDoc As Word.Document
  24.     Set WordApp = CreateObject("Word.Application" )
  25.     WordApp.Visible = True
  26.     Set WordDoc = WordApp.Documents.Open(fichier, ReadOnly:=True)
  29. End Sub
  30. Sub pilot_word(fichier As String)
  31. Dim WordDoc As Word.Document
  32.     On Error Resume Next
  33.     Set WordDoc = GetObject(fichier)
  34.     MsgBox WordDoc.Paragraphs.Count
  35. End Sub
  36. ''
  37. Sub replace()
  38. 'grande inconnue'
  39. 'parcours word, dès qu'elle trouve \ref{ elle regarde ce qu'il y a derrière'
  40. 'va le ch dans excel biblio.xls et copie la valeur de la colonne numero à la ligne correspondante'
  41. 'le problème n'étant pas toruver dans exxcel, mais toruver dans word'
  42. end sub
  43. '
  44. Sub copybiblio()
  45. Dim WordApp As Word.Application
  46. Dim WordDoc As Word.Document
  48.     Set WordApp = New Word.Application
  49.     WordApp.Visible = True
  50.     Set WordDoc = GetObject("essai.doc" )
  52.     Range("A1:g40" ).Value.Copy
  54.     WordApp.Selection.Paste
  55. '    WordDoc.Tables(1).AutoFitBehavior wdAutoFitWindow
  56. 'cette ligne pose problème member not found
  57.     Application.CutCopyMode = False
  58. End Sub
  59. sub save_doc(fchier as string)
  60. Dim WordApp As Word.Application
  61. Dim WordDoc As Word.Document
  62.     WordDoc.SaveAs fichier
  63. end sub


 
Bon je précise que je sais pas du tout faire ce genre de manip, d'habitude vba ne me pose pas trop de pb, mais là je bloque, la manipulatio nd'appli externe c'est assez chaud je trouve. Donc si j'ai l'air d'un cake avec mon bout de code à deux francs c'est normal (d'ailleurs c'est même pas le mien piske le s procedures viennet de vbdeveloppez.com il me semble)
----------
edit :
j'ai trouvé ça sur le forum :http://forum.hardware.fr/hfr/Programmation/VB-VBA-VBS/vba-chercher-remplacer-sujet_99726_1.htm

Code :
  1. Set word_app = CreateObject("Word.Application" )
  2. With word_app
  3. .Visible = True
  4. .WindowState = wdWindowStateMaximize
  5. End With
  6. Set word_fichier = word_app.Documents.Open(monfichier)
  7. word_app.Selection.Find.ClearFormatting
  8. word_app.Selection.Find.Replacement.ClearFormatting
  9. With word_app.Selection.Find
  10. .Text = "--Champs1--"
  11. .Replacement.Text = "BonjouR"
  12. .Forward = True
  13. .Wrap = wdFindContinue
  14. .Format = False
  15. .MatchCase = False
  16. .MatchWholeWord = False
  17. .MatchWildcards = False
  18. .MatchSoundsLike = False
  19. .MatchAllWordForms = False
  20. End With
  21. word_app.Selection.Find.Execute replace:=2


Mais je vois pas encore comment faire comprendre à word que lorsqu'il trouve  ---Champs---1, il doit regarder ce qu'il y a derrière et demander alors le mot de remp à XL
 
----
edit 2 :
une piste que je travaille :
http://www.developpez.net/forums/s [...] p?t=315074
 
 
merci


Message édité par merenptah44 le 11-05-2007 à 15:59:17
Reply

Marsh Posté le 11-05-2007 à 16:19:24    

merenptah44 a écrit :


- je n'utilise aps LaTeX pour ceux qui connaisse (cadre d'un stage, il me faut un format universel, et LaTeX en est pas un...)


 
 :sweat: tu rigoles j'espere ??

Message cité 1 fois
Reply

Marsh Posté le 11-05-2007 à 16:24:16    

Joel F a écrit :

:sweat: tu rigoles j'espere ??


 
petite précision, utilisant TexLive à la maison, je n'arrive pas à faire du Ltx2doc, et c un peu gênant dans le snes ou tout les fichiers doc que j'utilise doivent subir des révisions avant d'être publié.
de plus je ne bosse pas sur mon ordi perso, et j'ai pas de bilibo latex installé dessus alors que sur n'importe quel ordi de bureau on a le pack office, c'est dans ce sens là ouù je dis que c'est pas universel, même si ça me chagrine  
 
le joyeux monde de l'entreprise

Reply

Marsh Posté le 11-05-2007 à 16:26:19    

t'installe Miktex sur une clé USB et roulez quoi, tu leur refile le PDF finale te basta ...

Message cité 1 fois
Reply

Marsh Posté le 11-05-2007 à 18:05:42    

Joel F a écrit :

t'installe Miktex sur une clé USB et roulez quoi, tu leur refile le PDF finale te basta ...


et non parcequ'il doit y  avoir quelqu'nu qui pond le rapport, un autre qui le vérifie et un autre qui l'approuve, et lors de la verif, ils ont pour habitude de bosser directement dedans. Cela dit c'est vrai que j'avais pas pensé au MikteX sur clé, à travailler comme idée

Reply

Marsh Posté le 11-05-2007 à 19:43:08    

acrobat permets d'editer des commentaires dans un pdf :p

Reply

Marsh Posté le 14-05-2007 à 15:49:58    

Bon j'en suis là pour l'instant :

Code :
  1. Sub majbiblio()
  2. Dim Wrd As Word.Application
  3. Dim fl As Worksheet
  4. Dim NoLigne As Long, i As Long, LeText As String, LaRech As String
  5.     Set fl = ActiveSheet
  6.     Set Wrd = CreateObject("Word.Application" )
  7.     Wrd.Visible = True
  8.     Wrd.DisplayAlerts = wdAlertsNone
  9.     Wrd.Documents.Open FileName:=("c:\work\report\essai.doc" )
  10.     Wrd.ActiveDocument.SaveAs FileName:=("c:\work\report\essai-biblio.doc" )
  11. 2:    Wrd.Selection.HomeKey Unit:=wdStory
  12.     With Wrd.Selection.Find
  13.         .Text = "\ref{"
  14.         .Execute
  15.     End With
  16.     With Wrd.Selection
  17.         .ExtendMode = True 'Étend la sélection à la balise suivante
  18.         With .Find
  19.             .Text = "}"
  20.             .Execute
  21.         End With
  22.     End With
  23.     '******************************************************************
  24.     LeText = Wrd.Selection
  25.     LaRech = Mid(LeText, 6, Len(LeText) - 5 - 1)
  26.     nbvar = Application.CountA(Range("a:a" ))
  27.     trouve = False
  28.     if LeText <> Empty then
  29.     For i = 2 To nbvar
  30.     cequejech = fl.Cells(i, 11).Value
  31.     If InStr(1, cequejech, LaRech, 1) <> 0 Then
  32.     valref = CStr(fl.Cells(i, 1).Text & fl.Cells(i, 2).Text & fl.Cells(i, 3).Text)
  33.     Wrd.Selection = valref
  34.     trouve = True
  35.     i = nbvar
  36.     End If
  37.     Next
  38.     If trouve = True Then
  39.     Wrd.ActiveDocument.SaveAs FileName:=("c:\work\acergy\rapport\essai-biblio.doc" )
  40.     Else
  41.     MsgBox (LaRech & "N'est pas un mot clé valide" )
  42.     End If
  43. goto 2
  44. end if
  45.     Wrd.Quit
  46. End Sub


plusieurs remarques :
- je dois permettre une selection du fichier dans la feuille excel (plutôt que l'adresse dans le code) (easy)
- je dois rajouter une boulce qui vérifie que ttes les références de la feuilles excel sont rentrées (easy)
- je dois pas ouvrir correctement car  
                      - si essai.doc est déjà ouvert message d'erreur
                      - qd je quitte le word, il me parles du normal.dot, etc... et j'aimerai bien m'éviter cette galère (cela dit je l'évites avec un petit wrd.visible=false au pire)
- je dois rajouter une copie de tout mon tableau à l'emplacement prévu à cet effet ds de mon word et ça pas east
donc voilà si queqlu'un sait comment je pourrais faire tourner sur tout mon document word sans le goto qui est pas très propre
 
merci d'avance

Message cité 1 fois
Message édité par merenptah44 le 14-05-2007 à 16:06:58
Reply

Marsh Posté le 15-05-2007 à 11:02:31    

merenptah44 a écrit :


plusieurs remarques :
- je dois permettre une selection du fichier dans la feuille excel (plutôt que l'adresse dans le code) (easy)
- je dois rajouter une boulce qui vérifie que ttes les références de la feuilles excel sont rentrées (easy)

- je dois pas ouvrir correctement car  
                      - si essai.doc est déjà ouvert message d'erreur
                      - qd je quitte le word, il me parles du normal.dot, etc... et j'aimerai bien m'éviter cette galère (cela dit je l'évites avec un petit wrd.visible=false au pire)
- je dois rajouter une copie de tout mon tableau à l'emplacement prévu à cet effet ds de mon word et ça pas east
donc voilà si queqlu'un sait comment je pourrais faire tourner sur tout mon document word sans le goto qui est pas très propre


pour cedernier point je souhaiterais savoir si quelqu'un sait comment placer le curseur où l'on veut, genre début de document par exemple, après il me suiffit de faire une recherche pour choisir l'emplacmeent que je souhaite. mais je ne sais pas comment ramener le curseur au début...
de plus savez vous comment par vba excel vers word on peut faire un collage avec mise en forme automatique du tableau ?
 
merci d'avance


Message édité par merenptah44 le 15-05-2007 à 11:03:29
Reply

Marsh Posté le 15-05-2007 à 11:02:31   

Reply

Marsh Posté le 15-05-2007 à 11:14:37    

je crois qu'il faut voir du coté de : activedocument.gotoXXX selon tes besoins

Reply

Marsh Posté le 16-05-2007 à 11:05:08    

et voila ce que ça donne :
 

Code :
  1. Sub majbiblio()
  2. Dim Wrd As Word.Application
  3. Dim fl As Worksheet
  4. Dim NoLigne As Long, i As Long, LeText As String, LaRech As String
  5. Dim fichier As String, fichiersav As String
  6.     'ouverture et sauveegarde du fichier word sous un autre nom
  7.     fichier = CStr(Cells(2, 14).Value)
  8.     fichiersav = Mid(fichier, 1, Len(fichier) - 4) & "-biblio.doc"
  9.     'mettre la ligne suivante en comment pour debogage
  10.     On Error GoTo anticipatedend ' si le fichier est ouvert, n'existe pas ...
  11.     Set fl = ActiveSheet
  12.     Set Wrd = CreateObject("Word.Application" )
  13.     Wrd.Visible = False ' à passer en true si besoin de debogage
  14.     Wrd.DisplayAlerts = wdAlertsNone
  15.     Wrd.Documents.Open FileName:=(fichier)
  16.     Wrd.ActiveDocument.SaveAs FileName:=(fichiersav)
  17.     'verification du tableau biblio.xls pour voir s'il ne manque pas de référence
  18.     nbvar = Application.CountA(Range("d:d" )) 'title est dans la colonne d, supposée sans trous
  19.     For i = 1 To nbvar
  20.         If IsEmpty(fl.Cells(i, 10)) = True Then
  21.         MsgBox "Check your reference names in your bibliography"
  22.         GoTo quitnow
  23.         End If
  24.     Next i
  25.     Wrd.Selection.HomeKey Unit:=wdStory
  26. rerun:
  27.         Wrd.Selection.EndKey
  28.         Wrd.Selection.ExtendMode = False
  29.         With Wrd.Selection.Find
  30.             .Text = "\ref{"
  31.             .Execute
  32.         End With
  33.         With Wrd.Selection
  34.             .ExtendMode = True 'Étend la sélection à la balise suivante
  35.             With .Find
  36.                 .Text = "}"
  37.                 .Execute
  38.             End With
  39.         End With
  40.     '******************************************************************
  41.         LeText = Wrd.Selection
  42.         If LeText = Chr(13) Or LeText = Chr(7) Then
  43.         GoTo normalend
  44.         End If
  45.         LaRech = Mid(LeText, 6, Len(LeText) - 5 - 1)
  46.         If IsEmpty(LeText) = False Then
  47.             trouve = False
  48.             For i = 2 To nbvar
  49.                 cequejech = fl.Cells(i, 10).Value
  50.             If InStr(1, cequejech, LaRech, 1) <> 0 Then
  51.                 valref = CStr(fl.Cells(i, 2))
  52.                 Wrd.Selection.Delete
  53.                 Wrd.Selection.InsertAfter valref
  54.                 trouve = True
  55.                 i = nbvar
  56.             End If
  57.             Next
  58.             If trouve = False Then
  59.                 Wrd.ActiveDocument.SaveAs FileName:=(fichiersav)
  60.                 Message = MsgBox(LaRech & " n'est pas un mot clé valide, arrêter ?", vbYesNo + vbQuestion, "Reference error" )
  61.                 If Message = vbYes Then GoTo quitnow Else GoTo rerun
  62.                 End If
  63.                 GoTo rerun
  64.         End If
  65.         GoTo normalend
  66. '******************************************************************
  67. anticipatedend:
  68.             MsgBox "File already opened or wrong name and/or directory"
  69.             GoTo quitnow:
  70. '******************************************************************
  71. normalend:
  72.             Wrd.ActiveDocument.SaveAs FileName:=(fichiersav)     
  73.             With Wrd.Selection.Find
  74.             .Text = "Bibliography and References"
  75.             .Execute
  76.             End With
  77.             If Wrd.Selection = Chr(13) Or Wrd.Selection = Chr(7) Then
  78.             MsgBox "Insert somewhere in your file the term : " & " Bibliography and References"
  79.             GoTo quitnow
  80.             End If
  81.             Wrd.Selection.EndKey
  82.             Wrd.Selection.Goto what:=wdGoToLine, which:=wdGoToNext
  83.             Range("B1:I" & nbvar).Copy
  84.             Wrd.Selection.PasteSpecial DataType:=wdPasteBitmap, Placement:=wdInLine
  85.             'Wrd.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
  86.             Application.CutCopyMode = False
  87.             Wrd.ActiveDocument.SaveAs FileName:=(fichiersav)
  88. '******************************************************************
  89. quitnow:
  90.         Wrd.Quit
  91. End Sub


 
si quelqu'un a des idées pour méliorer ce code qui doit pas être le plus optimum...
 
à +


Message édité par merenptah44 le 16-05-2007 à 11:29:51
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed