vbscript 新期刊发表

Posted 2021-05-21

Sub newJournalPublishFooterHeader()
'On Error GoTo kr
Selection.HomeKey wdStory
Dim arr
Dim doi, aimT, articleNum, volume, pageCount, getT, lastPage, startPage As String
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then ActiveWindow.Panes(2).Close
'10.3390/ijms19113413
getT = InputBox("please insert starting page and doi number", "get doi number", "1 doi:", 300, 300)
If getT = "" Then
    Exit Sub
End If

arr = Split(getT, " ")
startPage = arr(0):  doi = arr(1)
pageCount = ActiveDocument.Range.Information(wdNumberOfPagesInDocument)
lastPage = CInt(startPage) + pageCount - 1

Dim reg As New RegExp
Dim matches
With reg
    .Global = True
    .Pattern = "(?!=\d)\d+$"
Set matches = reg.Execute(doi)
End With
aimT = matches(0)

volume = Left(aimT, Len(aimT) - 6)
If Left(volume, 1) = "0" Then
    volume = Right(volume, 1)
End If

'articleNum = Right(aimT, 4)
'Do While (Left(articleNum, 1) = "0")
'    articleNum = Right(articleNum, Len(articleNum) - 1)
'Loop

pageRange = startPage + ChrW(8211) + CStr(lastPage)
WordBasic.ViewFooterOnly

Call publishFormat(CStr(year(Date)) + ", " + volume + ", " + pageRange + "; " + doi)

WordBasic.ViewheaderOnly
ActiveWindow.ActivePane.View.NextHeaderFooter

Call publishFormat(CStr(year(Date)) + ", " + volume)

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Exit Sub
kr:
    MsgBox "Please check if doi number is correct"
End Sub
Sub publishFormat(str As String)
Selection.WholeStory
With Selection.Find
    .Text = "[0-9]{4}"
    .Font.Bold = -1
    .MatchWildcards = True
    .Execute
    If .Found = False Then
        Exit Sub
    End If
End With

With Selection
    .MoveEndUntil Chr(9)
    .Font.Bold = 0
    .Font.Italic = 0
    .Text = str
    .Collapse wdCollapseStart
    If Selection.Previous(wdCharacter, 1) <> " " Then
        Selection.InsertBefore " "
        .Collapse wdCollapseEnd
    End If
    .MoveRight wdCharacter, 4, wdExtend
    .Font.Bold = -1
    .MoveRight wdCharacter, 3
   .MoveEndUntil ","
    .Font.Italic = -1
    .Collapse wdCollapseStart
End With
End Sub