[sources] Generer une bibliographie depuis excel vers word

[merenptah44]

Bonjour à tous, je sais si c'es tle bon endroit, mais je propose une source ça peut servir à ceux qui tape des rapports de stage et autres.

Cette marco génère une bilio dans word à partir decelle que vous aurez tapé sous excel et de plus numérote automatiquement vos références dans le word à la manière de LaTeX pour ceux qui connaissent.

cela servira à ceux qui ont des vieilles versions de word qui ne le font que difficilement

Je m'explique :
vous souhaitez citer le forum developpez.com dans votre rapport
dans word :
blablabla \ref{dev.com}
dans excel :
colonne numéro,auteur, tirtre, année,... à remplir comme vous le voulez
dernière colonne : reference vous mettez à la ligne correspondant dev.com

et la marco remplacera \ref{dev.com} par [5] si c'est la 5eme ligne.

Seul pb le fichier excel doit avoir le format que j'ai donné. il est dispo à la fin de ce message
voici le code :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
 
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

je précise que la macro copie en plus à la fin de votre rapport le tableau biblio.xls
J'attends vos propositions pour améliorer le code

à savoir que la prochaine évolution sera derefaire automatiquement la mise en page et la numérotation dans le fichier excel (c'est facile je sais mais là j'ai une grosse flemme)

[merenptah44]

un modo peut-il déplacer mon sujet dans excel/contribuer que je n'avais pas vu (je sais il faut le faire )!!!
merci !!