毕业论文的参考文献部分个人觉得是最麻烦的,因为要按在正文中出现的顺序来,所以一旦文本有顺序变动,很有可能导致得重新排列文献。身为程序员,我们必须厌恶这种重复劳动~
今天下午写了个VBA脚本解决这个问题。虽然没什么技术含量,不过感觉还是能解决问题节省不少气力的~尤其是如果在写作一开始就用的话~这里简单介绍一下使用方法,觉得好的童鞋就拿去用吧~
这个Operation就是用来格式化的宏,不过现在还是没有的。点编辑
进入VBA编辑器后,在左上角的工程窗口里找到 normal下的newmacros,如果没有的话就自己在模块下建一个模块
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(否则我这懒人怎么会自己写呢……)
希望对大家有帮助