[Resolu] [VBA] Macro bibliographie sous word

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : [Resolu] [VBA] Macro bibliographie sous word

merenptah44

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

Publicité

jpcheck

Pioupiou

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

Message cité 1 fois

merenptah44

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 :

Sub main()
Dim fichierdoc As String
fichierdoc = Cells(1, 1).Value
open_word (fichierdoc)
pilot_word (fichierdoc)
replace()
copybiblio()
save-doc(fichierdoc.value(1,Len(fichierdoc)-4 & "-biliboadded)
End Sub
''
Sub create_word()
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Set WordApp = CreateObject("Word.Application" ) '-- ouvre une session Word
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Add '-- crée un nouveau document
WordDoc.SaveAs "C:\monDocument.doc" '-- enregistre le nouveau doc
End Sub
Sub open_word(fichier As String)
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Set WordApp = CreateObject("Word.Application" )
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Open(fichier, ReadOnly:=True)
End Sub
Sub pilot_word(fichier As String)
Dim WordDoc As Word.Document
On Error Resume Next
Set WordDoc = GetObject(fichier)
MsgBox WordDoc.Paragraphs.Count
End Sub
''
Sub replace()
'grande inconnue'
'parcours word, dès qu'elle trouve \ref{ elle regarde ce qu'il y a derrière'
'va le ch dans excel biblio.xls et copie la valeur de la colonne numero à la ligne correspondante'
'le problème n'étant pas toruver dans exxcel, mais toruver dans word'
end sub
'
Sub copybiblio()
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Set WordApp = New Word.Application
WordApp.Visible = True
Set WordDoc = GetObject("essai.doc" )
Range("A1:g40" ).Value.Copy
WordApp.Selection.Paste
' WordDoc.Tables(1).AutoFitBehavior wdAutoFitWindow
'cette ligne pose problème member not found
Application.CutCopyMode = False
End Sub
sub save_doc(fchier as string)
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
WordDoc.SaveAs fichier
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 :

Set word_app = CreateObject("Word.Application" )
With word_app
.Visible = True
.WindowState = wdWindowStateMaximize
End With
Set word_fichier = word_app.Documents.Open(monfichier)
word_app.Selection.Find.ClearFormatting
word_app.Selection.Find.Replacement.ClearFormatting
With word_app.Selection.Find
.Text = "--Champs1--"
.Replacement.Text = "BonjouR"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
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

Joel F

Real men use unique_ptr

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

merenptah44

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

Joel F

Real men use unique_ptr

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

Message cité 1 fois

merenptah44

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

Joel F

Real men use unique_ptr

acrobat permets d'editer des commentaires dans un pdf

merenptah44

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

Code :

Sub majbiblio()
Dim Wrd As Word.Application
Dim fl As Worksheet
Dim NoLigne As Long, i As Long, LeText As String, LaRech As String
Set fl = ActiveSheet
Set Wrd = CreateObject("Word.Application" )
Wrd.Visible = True
Wrd.DisplayAlerts = wdAlertsNone
Wrd.Documents.Open FileName:=("c:\work\report\essai.doc" )
Wrd.ActiveDocument.SaveAs FileName:=("c:\work\report\essai-biblio.doc" )
2: Wrd.Selection.HomeKey Unit:=wdStory
With Wrd.Selection.Find
.Text = "\ref{"
.Execute
End With
With Wrd.Selection
.ExtendMode = True 'Étend la sélection à la balise suivante
With .Find
.Text = "}"
.Execute
End With
End With
'******************************************************************
LeText = Wrd.Selection
LaRech = Mid(LeText, 6, Len(LeText) - 5 - 1)
nbvar = Application.CountA(Range("a:a" ))
trouve = False
if LeText <> Empty then
For i = 2 To nbvar
cequejech = fl.Cells(i, 11).Value
If InStr(1, cequejech, LaRech, 1) <> 0 Then
valref = CStr(fl.Cells(i, 1).Text & fl.Cells(i, 2).Text & fl.Cells(i, 3).Text)
Wrd.Selection = valref
trouve = True
i = nbvar
End If
Next
If trouve = True Then
Wrd.ActiveDocument.SaveAs FileName:=("c:\work\acergy\rapport\essai-biblio.doc" )
Else
MsgBox (LaRech & "N'est pas un mot clé valide" )
End If
goto 2
end if
Wrd.Quit
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

merenptah44

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

Publicité

jpcheck

Pioupiou

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

merenptah44

et voila ce que ça donne :

Code :

Sub majbiblio()
Dim Wrd As Word.Application
Dim fl As Worksheet
Dim NoLigne As Long, i As Long, LeText As String, LaRech As String
Dim fichier As String, fichiersav As String
'ouverture et sauveegarde du fichier word sous un autre nom
fichier = CStr(Cells(2, 14).Value)
fichiersav = Mid(fichier, 1, Len(fichier) - 4) & "-biblio.doc"
'mettre la ligne suivante en comment pour debogage
On Error GoTo anticipatedend ' si le fichier est ouvert, n'existe pas ...
Set fl = ActiveSheet
Set Wrd = CreateObject("Word.Application" )
Wrd.Visible = False ' à passer en true si besoin de debogage
Wrd.DisplayAlerts = wdAlertsNone
Wrd.Documents.Open FileName:=(fichier)
Wrd.ActiveDocument.SaveAs FileName:=(fichiersav)
'verification du tableau biblio.xls pour voir s'il ne manque pas de référence
nbvar = Application.CountA(Range("d:d" )) 'title est dans la colonne d, supposée sans trous
For i = 1 To nbvar
If IsEmpty(fl.Cells(i, 10)) = True Then
MsgBox "Check your reference names in your bibliography"
GoTo quitnow
End If
Next i
Wrd.Selection.HomeKey Unit:=wdStory
rerun:
Wrd.Selection.EndKey
Wrd.Selection.ExtendMode = False
With Wrd.Selection.Find
.Text = "\ref{"
.Execute
End With
With Wrd.Selection
.ExtendMode = True 'Étend la sélection à la balise suivante
With .Find
.Text = "}"
.Execute
End With
End With
'******************************************************************
LeText = Wrd.Selection
If LeText = Chr(13) Or LeText = Chr(7) Then
GoTo normalend
End If
LaRech = Mid(LeText, 6, Len(LeText) - 5 - 1)
If IsEmpty(LeText) = False Then
trouve = False
For i = 2 To nbvar
cequejech = fl.Cells(i, 10).Value
If InStr(1, cequejech, LaRech, 1) <> 0 Then
valref = CStr(fl.Cells(i, 2))
Wrd.Selection.Delete
Wrd.Selection.InsertAfter valref
trouve = True
i = nbvar
End If
Next
If trouve = False Then
Wrd.ActiveDocument.SaveAs FileName:=(fichiersav)
Message = MsgBox(LaRech & " n'est pas un mot clé valide, arrêter ?", vbYesNo + vbQuestion, "Reference error" )
If Message = vbYes Then GoTo quitnow Else GoTo rerun
End If
GoTo rerun
End If
GoTo normalend
'******************************************************************
anticipatedend:
MsgBox "File already opened or wrong name and/or directory"
GoTo quitnow:
'******************************************************************
normalend:
Wrd.ActiveDocument.SaveAs FileName:=(fichiersav)
With Wrd.Selection.Find
.Text = "Bibliography and References"
.Execute
End With
If Wrd.Selection = Chr(13) Or Wrd.Selection = Chr(7) Then
MsgBox "Insert somewhere in your file the term : " & " Bibliography and References"
GoTo quitnow
End If
Wrd.Selection.EndKey
Wrd.Selection.Goto what:=wdGoToLine, which:=wdGoToNext
Range("B1:I" & nbvar).Copy
Wrd.Selection.PasteSpecial DataType:=wdPasteBitmap, Placement:=wdInLine
'Wrd.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Application.CutCopyMode = False
Wrd.ActiveDocument.SaveAs FileName:=(fichiersav)
'******************************************************************
quitnow:
Wrd.Quit
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

FORUM HardWare.fr

Programmation

VB/VBA/VBS

[Resolu] [VBA] Macro bibliographie sous word

Sujets relatifs
Webservices et JNI [resolu]	[Resolu]executer script sur machine distante
[Résolu] Conflit entre deux fichiers js (plusieurs onLoad)	[RESOLU] ASP.NET et AJAX 1.0, intellisense KO
Grosse Macro ne fonctionne plus	Word mise à jour userform
Résolu : Je cherche l'outil de saisie style explorateur en VB	[Résolu][Débutant C#] - Requete SQL
Mot de passe géré par une macro	Calcul de durée totale/de session
Plus de sujets relatifs à : [Resolu] [VBA] Macro bibliographie sous word

Page générée en 0.115 secondes