毕业论文参考文献自动排列脚本(杭电)

毕业论文的参考文献部分个人觉得是最麻烦的，因为要按在正文中出现的顺序来，所以一旦文本有顺序变动，很有可能导致得重新排列文献。身为程序员，我们必须厌恶这种重复劳动~

今天下午写了个VBA脚本解决这个问题。虽然没什么技术含量，不过感觉还是能解决问题节省不少气力的~尤其是如果在写作一开始就用的话~这里简单介绍一下使用方法，觉得好的童鞋就拿去用吧~

1)导入脚本

#此节方便不熟悉office宏的童鞋

以Word2010为例，点击 视图 - 宏

这个Operation就是用来格式化的宏，不过现在还是没有的。点编辑


进入VBA编辑器后，在左上角的工程窗口里找到 normal下的newmacros，如果没有的话就自己在模块下建一个模块

双击打开，把VBA代码赋值进去：

Function CollectionSort(ByRef oCollection As Collection, Optional bSortAscending As Boolean = True) As Long
    Dim lSort1 As Long, lSort2 As Long
    Dim vTempItem1 As Variant, vTempItem2 As Variant, bSwap As Boolean
    
    For lSort1 = 1 To oCollection.Count - 1
        For lSort2 = lSort1 + 1 To oCollection.Count
            If bSortAscending Then
                If oCollection(lSort1) > oCollection(lSort2) Then
                    bSwap = True
                Else
                    bSwap = False
                End If
            Else
                If oCollection(lSort1) < oCollection(lSort2) Then
                    bSwap = True
                Else
                    bSwap = False
                End If
            End If
            If bSwap Then
                'Store the items
                If VarType(oCollection(lSort1)) = vbObject Then
                    Set vTempItem1 = oCollection(lSort1)
                Else
                    vTempItem1 = oCollection(lSort1)
                End If
                
                If VarType(oCollection(lSort2)) = vbObject Then
                    Set vTempItem2 = oCollection(lSort2)
                Else
                    vTempItem2 = oCollection(lSort2)
                End If
                
                'Swap the items over
                oCollection.Add vTempItem1, , lSort2
                oCollection.Add vTempItem2, , lSort1
                'Delete the original items
                oCollection.Remove lSort1 + 1
                oCollection.Remove lSort2 + 1
            End If
        Next
    Next
End Function

Function GetResult(ByRef arr As Collection)
    CollectionSort arr
    
    Dim result As String
    flag = False
    For i = 1 To arr.Count
        If i = arr.Count Then
            result = result & "[" & arr(i) & "]"
            Exit For
        End If
        If flag = False Then
            result = result & "[" & arr(i)
            If arr(i) + 1 = arr(i + 1) Then
                flag = True
                result = result & "-"
            Else
                result = result & "]"
            End If
        Else
            If arr(i) + 1 = arr(i + 1) Then
                If i + 1 = arr.Count Then
                    result = result & arr(i + 1) & "]"
                    Exit For
                End If
            Else
                result = result & arr(i) & "]"
            End If
        End If
    Next
    GetResult = result
End Function


Sub Operation()
    '查找参考文献插入位置
    With Selection.Find
        .Text = "{references}" '表征插入位置的标签
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Dim result As Range '记录插入位置
    Set result = Selection.Range
    result.Text = ""
    
    Dim c As Comment
    Dim dic As Scripting.Dictionary '保存已经出现过的参考文献
    Set dic = New Scripting.Dictionary
    i = 0   '记录标号
    For Each c In ActiveDocument.Comments
        If c.Scope.Text = "[]" Then
            c.Scope.Text = ""
            Dim p As Paragraph
            Dim indexs As Collection
            Set indexs = New Collection
            For Each p In c.Range.Paragraphs
                If Left(p.Range.Text, 1) = "@" Then
                    If Not dic.Exists(p.Range.Text) Then
                        i = i + 1
                        dic(p.Range.Text) = i
                        result.Text = result.Text & "[" & dic(p.Range.Text) & "]" & Right(p.Range.Text, Len(p.Range.Text) - 1)
                    End If
                    indexs.Add dic(p.Range.Text)
                End If
            Next
            c.Scope.Select
            Selection.Text = GetResult(indexs)
            Selection.Font.Superscript = wdToggle
            
            c.Delete
        End If
    Next
    
    
End Sub

 

还要注意一下Word的安全性设置。打开word选项，点击信任中心，选择启用所有宏

2)编写模版

#生成每条参考文献不是这个脚本的功能，不过推荐使用这个http://rolfzhang.com/articles/940.html

有以下几个规则：

a)[]表示要插入引用的地方，参考文献通过批注插入在这里：

这样做的原因是批注可以随着文字移动，这样的话就可以重排文字而不用担心顺序的问题了。

b)参考文献之前必须加@，以和一般批注相区别（如上图）

c)一个批注里可以有多个参考文献，以@开头即可

d)多个完全相同的参考文献会自动合并

e)在需要插入参考文献的地方写上{references}

3)运行宏

运行之前强烈建议先另存为上面的成果（以批注的形式添加完所有引用，标注好references，但不要执行脚本），因为转换的过程是不可逆的~

再次打开宏面板，选中operation执行

等待奇迹发生吧。。。

之后就和脚本毫无关系了。。。。

有问题咨询QQ:39977397

主要思想来自于已经失传的软件Ref-tidying（否则我这懒人怎么会自己写呢……）

希望对大家有帮助