vbscript ZR添加乳胶名称 - 年龄8-17

Posted 2021-05-21

Sub ZR_Latex_Name_year(ByVal control As IRibbonControl)
Call layout_search_replace.ZRjump_to_reference_section
    Selection.MoveDown wdParagraph, 1
    Selection.EndKey wdStory, wdExtend
Call Chicago.addlinenum

Dim label As Integer

Call findLatexNameYear("^13[!\\^13]@[0-9]{4}[a-z][a-z]", 6)
Call findLatexNameYear("^13[!\\^13]@[0-9]{4}[a-z]", 5)
Call findLatexNameYear("^13[!\\^13]@[0-9]{4}", 4)


 Call layout_search_replace.ZRjump_to_reference_section
    Selection.MoveDown wdParagraph, 1
    Selection.EndKey wdStory, wdExtend
Call Chicago.removelinenum
With ActiveDocument.Content.Find
  .ClearFormatting
  .Text = "(\}) ([A-Z])"
  .MatchWildcards = True
  .Replacement.Text = "\1^p\2"
  .Execute Replace:=wdReplaceAll
End With
Call layout_search_replace.ZRjump_to_reference_section
End Sub
Sub findLatexNameYear(str As String, yearCount As Integer)
Call layout_search_replace.ZRjump_to_reference_section
  With Selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
      .Text = str
      .Replacement.Text = ""
      .MatchWildcards = True
      .Wrap = wdFindStop
      Do
      .Execute
      If Not .Found Then
      Exit Do
      End If
      If .Found Then '
      Dim myrange As Range
      Set myrange = Selection.Range
      
  
      Set myrange = ActiveDocument.Range(Selection.Range.Start + 1, Selection.Range.End)
      
          label = myrange.ListParagraphs(1).Range.ListFormat.ListValue
          Selection.Range = ZRLatexcountName(myrange.Text, CInt(label), yearCount)
          Selection.MoveDown wdLine
      End If
      Loop
  End With
End Sub
Function ZRLatexcountName(AnyStr As String, str As Integer, yearCount As Integer)
Dim i As Integer
Dim RegEx
Dim myname As String
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
    .Global = True
    .Pattern = "\,"
End With
Select Case RegEx.Execute(AnyStr).count
Case Is = 0
If InStr(AnyStr, ".") > 0 Then
'\bibitem[name(year)]{label}

    myname = "\bibitem[" + Left(AnyStr, InStr(AnyStr, " ") - 1) + "(" + Right(AnyStr, yearCount) + ")]" + "{" + CStr(str) + "}"
    
End If

Case Is = 1

Dim arr, arr1
arr = Split(AnyStr, ", ")
arr1 = Split(arr(1), " ")
If InStr(AnyStr, ".") > 0 Then
   myname = "\bibitem[" + Left(AnyStr, InStr(AnyStr, ",") - 1) + " & " + arr1(0) + "(" + Right(AnyStr, yearCount) + ")]" + "{" + CStr(str) + "}"

  
End If


Case Is > 1
    myname = "\bibitem[" + Left(AnyStr, InStr(AnyStr, " ") - 1) + " " + "et al." + "(" + Right(AnyStr, yearCount) + ")]" + "{" + CStr(str) + "}"
    
End Select

AnyStr = vbCrLf + myname + " " + AnyStr

ZRLatexcountName = AnyStr
Set RegEx = Nothing
End Function