kerrypnx
11/1/2018 - 7:08 AM
publish
revise 11-5
Sub oneKeyPublish(ByVal control As IRibbonControl)
Selection.HomeKey wdStory
publishDate
publishFooterHeader
deleteChicagoNameYear
detectCopyright
Selection.HomeKey wdStory
End Sub
Sub pageJournalPublish(ByVal control As IRibbonControl)
Selection.HomeKey wdStory
publishDate
newJournalPublishFooterHeader
deleteChicagoNameYear
detectCopyright
Selection.HomeKey wdStory
End Sub
Sub publishDate()
Dim myDay As String
If Left(day(Date), 1) = "0" Then
myDay = Right(day(Date), 1)
Else
myDay = day(Date)
End If
With Selection.Find
.ClearFormatting
.Wrap = wdFindStop
.Text = "; Published:"
.Replacement.Text = ""
.MatchWildcards = False
.Execute
If .Found Then
With Selection
.Collapse wdCollapseEnd
.MoveEndUntil ChrW(13)
.TypeText " " + myDay + " " + FunctionGroup.convertYear(CStr(Month(Date))) + " " + CStr(year(Date))
End With
End If
End With
End Sub
Sub publishFooterHeader()
On Error GoTo kr
Selection.HomeKey wdStory
Dim doi, aimT, articleNum, volume, myYear As String
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then ActiveWindow.Panes(2).Close
'10.3390/ijms19113413
doi = InputBox("please insert doi number", "get doi number", "doi:", 300, 300)
If doi = "" Then
Exit Sub
End If
If DateValue(CStr(Date)) > DateValue("2018/12/20") Then
myYear = "2019"
Else
myYear = "2018"
End If
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
WordBasic.ViewFooterOnly
Call publishFormat(myYear + ", " + volume + ", " + articleNum + "; " + doi)
WordBasic.ViewheaderOnly
ActiveWindow.ActivePane.View.NextHeaderFooter
Call publishFormat(myYear + ", " + volume + ", " + articleNum)
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Exit Sub
kr:
MsgBox "Please check if doi number is correct"
End Sub
Sub newJournalPublishFooterHeader()
On Error GoTo kr
Selection.HomeKey wdStory
Dim arr
Dim doi, aimT, articleNum, volume, pageCount, getT, lastpage, startPage, myYear As String
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then ActiveWindow.Panes(2).Close
'10.3390/ijms19113413
getT = InputBox("Please insert starting page and doi number (only a normal space between page and doi!!!)" + vbCrLf + vbCrLf + "Example: 12 doi:10.3390/ijms19113413", "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
If DateValue(CStr(Date)) > DateValue("2018/12/20") Then
myYear = "2019"
Else
myYear = "2018"
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(myYear + ", " + volume + ", " + pageRange + "; " + doi)
WordBasic.ViewheaderOnly
ActiveWindow.ActivePane.View.NextHeaderFooter
Call publishFormat(myYear + ", " + volume)
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Exit Sub
kr:
MsgBox "Please check if page and 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
Sub detectCopyright()
Dim layoutT, publishT, testT As String
layoutT = "by the authors. Submitted for possible open access"
layoutT1 = "by the author. Submitted for possible open access"
publishT = "by the authors. Licensee MDPI, Basel, Switzerland"
publishT1 = "by the author. Licensee MDPI, Basel, Switzerland"
With Selection.Find
.ClearFormatting
.Text = ChrW(169) + " [0-9]{4}"
.MatchWildcards = True
.Wrap = wdFindContinue
.Replacement.Text = ""
.Replacement.ClearFormatting
.Execute
If Not .Found Then
MsgBox "can't find copyRight"
Exit Sub
Else
testT = Selection.Paragraphs(1).Range.Text
If InStr(ActiveDocument.Paragraphs(3).Range.Text, ", ") > 0 Or InStr(ActiveDocument.Paragraphs(3).Range.Text, " and ") > 0 Then '如果是2个作者的话
If InStr(testT, publishT) = 0 Then
If InStr(testT, layoutT) > 0 Or InStr(testT, layoutT1) > 0 Or InStr(testT, publishT1) > 0 Then
Selection.Collapse wdCollapseEnd
Selection.MoveEndUntil Chr(13)
Selection.Delete
Selection.TypeText " by the authors. Licensee MDPI, Basel, Switzerland. This article is an open access article distributed under the terms and conditions of the Creative Commons Attribution (CC BY) license (http://creativecommons.org/licenses/by/4.0/)."
Else
Selection.MoveEndUntil Chr(13)
Selection.Range.HighlightColorIndex = wdRed
MsgBox "Different copyright, please check carefully!"
End If
End If
Else
If InStr(testT, publishT1) = 0 Then
If InStr(testT, layoutT) > 0 Or InStr(testT, layoutT1) Or InStr(testT, publishT) > 0 Then
Selection.Collapse wdCollapseEnd
Selection.MoveEndUntil Chr(13)
Selection.Delete
Selection.TypeText " by the author. Licensee MDPI, Basel, Switzerland. This article is an open access article distributed under the terms and conditions of the Creative Commons Attribution (CC BY) license (http://creativecommons.org/licenses/by/4.0/)."
Else
Selection.MoveEndUntil Chr(13)
Selection.Range.HighlightColorIndex = wdRed
MsgBox "Different copyright, please check carefully!"
End If
End If
End If
End If
End With
End Sub
Sub searchSuppleLink(ByVal control As IRibbonControl)
With Selection.Find
.ClearFormatting
.Text = "Supplementary Materials:"
.Replacement.Text = ""
.Font.Bold = -1
.MatchWildcards = True
.Execute
If Not .Found Then
MsgBox "No Supplementary Materials"
End If
End With
End Sub
Sub suppleLink(ByVal control As IRibbonControl)
Dim doi, volume, aimT
If Len(Selection.Text) < 4 Then
MsgBox "Please select text"
Exit Sub
End If
getfootertext = ActiveDocument.Sections(1).Footers(wdHeaderFooterFirstPage).Range.Text
If FunctionGroup.existDoi(CStr(getfootertext)) = False Then
MsgBox "I can't find doi number, please first run 'one key publish' function "
Exit Sub
End If
doi = Mid(getfootertext, InStr(getfootertext, ";") + 1, InStr(getfootertext, "www") - InStr(getfootertext, ";") - 2)
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
issue = Left(Right(aimT, 6), 2)
If Left(issue, 1) = "0" Then
issue = Right(issue, 1)
End If
If InStr(Selection.Text, "http://") > 0 Then
Selection.Text = "http://www.mdpi.com/" + FunctionGroup.getISSN() + "/" + volume + "/" + issue + "/" + articleNum + "/s1"
Else
Selection.Text = "www.mdpi.com/" + FunctionGroup.getISSN() + "/" + volume + "/" + issue + "/" + articleNum + "/s1"
End If
End Sub
Sub deleteChicagoNameYear()
Call kr_deck.aselect_whole_reference
Dim paraNum, i As Integer
i = 0
paraNum = Selection.Paragraphs.count
Selection.Collapse wdCollapseStart
Selection.MoveRight wdCharacter, 1, wdExtend
If Selection.Text <> "(" Then
Exit Sub
End If
Do While (i < paraNum)
Selection.MoveEndUntil ")"
Selection.MoveRight wdCharacter, 2, wdExtend
Selection.Delete
Selection.Move 4
i = i + 1
Loop
End Sub