Malicious Office (OOXML) — malware analysis report

Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "0{00020906-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Private WithEvents App As Word.Application
Attribute App.VB_VarHelpID = -1
Private Sub Document_Open()
Set App = Word.Application

End Sub

Private Sub App_DocumentBeforeSave(ByVal doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
Dim A
A = ActiveDocument.ComputeStatistics(Statistic:=wdStatisticWords, IncludeFootnotesAndEndnotes:=True)

End Sub

Attribute VB_Name = "article_metadata"
Attribute VB_Base = "0{DCAD0C91-4F62-4455-9BC3-8D7CAC3F9BAF}{F881987C-2CDE-4C0C-9FFB-C0B8BF3D03AB}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False







Private Sub submit_metadata_Click()

    Word.ActiveDocument.BuiltInDocumentProperties("Author") = authors
    Word.ActiveDocument.BuiltInDocumentProperties("Title") = title
    Word.ActiveDocument.BuiltInDocumentProperties("Subject") = abstract 'Left(abstract, 254)
    Word.ActiveDocument.BuiltInDocumentProperties("Keywords") = keywords


    Dim strpdfname As String
    
    Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
                         wdPrintDocumentWithMarkup, Copies:=1, Pages:="", PageType:= _
                         wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False, _
                         PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
                         PrintZoomPaperHeight:=0
    
    ' strpdfname = ActiveDocument.path & "\" & Left(ActiveDocument.Name, InStrRev(ActiveDocument.Name, ".") - 1) & ".pdf"

    '   ActiveDocument.ExportAsFixedFormat OutputFileName:= _
    '   strpdfname, _
    '    ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
    '   wdExportOptimizeForPrint, Range:=wdExportAllDocument, from:=1, To:=1, _
    '  Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
    '  CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
    ' BitmapMissingFonts:=True, UseISO19005_1:=True

    '''' below are codes to manipulate Acrobat.
    '''' single quotes are genuine codes, double or more quotes are comments

    ''Set pdapp = CreateObject("AcroExch.App")
    'Set pddoc = CreateObject("AcroExch.pddoc")
    '
    'pddoc.Open (strpdfname)
    ''pddoc.openavdoc (strpdfname)
    '
    'pddoc.SetPageMode (2)
    '
    ''====probably use pddoc.setinfo here to write author and keywords data to remove the quotation marks
    '' but syntax need to be researched
    '
    'Set jso = pddoc.getjsobject
    '
    ''msgbox jso.zoomtype.fitw gives fitwidth, but jso.zoomtype.fitw itself gives exception,
    ''and jso.zoomtype = jso.zoomtype.fitw does not work. maybe because vba mix upper case with lower case?
    ''consider use shell or command line to execute javascript if necessary? 'jso.layout also not working
    '
    'a = pddoc.Save(PDSaveIncremental, "")
    'pddoc.Close
    '
    'Dim strPrompt As String, editor_action As Integer
    '
    'strPrompt = "your pdf file has been generated at " & vbNewLine & strpdfname & vbNewLine & "please open the file and change magnification to fit width"
    'editor_action = MsgBox(strPrompt, vbOKCancel, "save as pdf done")
    '
    'If editor_action = 1 Then
    ''MsgBox (strpdfname)
    ''pdapp.Show
    'Else
    ''pdapp.exit
    'End If
    '
    'Set pddoc = Nothing

    MsgBox "Your pdf file has been generated at " & vbNewLine & strpdfname & vbNewLine, vbInformation
    article_metadata.Hide
End Sub



Attribute VB_Name = "doi_pub_date"
Attribute VB_Base = "0{05A4DAF5-8EC6-413C-9C12-643F77E841E4}{AE41BA59-1E36-4AC1-B9B7-A46A614305F0}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False


Private Sub submit_button_Click()
    Dim sect_number As Integer
    For sect_number = 1 To ActiveDocument.Sections.count Step 1
        ActiveDocument.Sections(sect_number).Range.Select

        '            If StrPtr(doi) <> 0 Then 'edit text if user did not click cancel
        '                selection.Text = doi
        '            End If
        'the above should be commented out once revised

        'selection.ClearCharacterAllFormatting
   
        Call liyuan_run.purge_header_footer_content_yuan(sect_number)
    Next sect_number
  
    ' With Selection
    '    .Font.Name = "Palatino Linotype"
    '    .Font.Size = 8
    '    .Font.Italic = True
    '    .TypeText ss
    '    .TypeText doi_pub_date.journal
    '    .Font.Italic = False
    '    'Selection.TypeText " "
    '    .Font.Bold = True
    '    .TypeText doi_pub_date.year
    '    .Font.Bold = False
    '    .TypeText ", "
    '    .Font.Italic = True
    '    .TypeText doi_pub_date.volume
    '    .Font.Italic = False
    '    .TypeText ", " & doi_pub_date.articlenumber & "; doi:" & doi & Format(doi_pub_date.articlenumber, "0000")   '& Chr(13)
    '
    'End With
    Selection.Collapse
    '   Selection.ClearFormatting
    With Selection.Find
        .Text = "Published:"
        .MatchWildcards = False
        .Forward = True
        .Wrap = wdFindStop
        .MatchByte = True
        .Font.Italic = True
        .Replacement.Text = ""
    End With
    Selection.Find.Execute

    If Selection.Find.Found Then
        With Selection
            .Collapse wdCollapseEnd
            .MoveEndUntil (Chr(13))
            .Font.Italic = True
            .Text = " " & doi_pub_date.pub_date
        End With
    Else
        '  MsgBox "I cannot find the line to insert publication date!" & vbCrLf & "Please manually set the publication date.", vbCritical
    End If

    'ActiveDocument.Paragraphs(1).Alignment = wdAlignParagraphLeft

    doi_pub_date.Hide
    
End Sub

Private Sub digits_Change()

    '
    '    digits.Value = Not digits.Value
    '
    '    If digits.Value = True Then
    '            doi.Text = Left(doi, Len(doi) - 4) & Format(Right(doi, 4), "00000")
    '    Else
    '            doi.Text = Left(doi, Len(doi) - 5) & Format(Right(doi, 5), "0000")
    '    End If
    '
End Sub


Attribute VB_Name = "layout_symbols"
Attribute VB_Base = "0{3834C159-6661-4358-8B10-6F630BE810FB}{999E6781-CEC0-4FA5-8577-DA577713FD38}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Private Sub CommandButton1_Click()
    Selection.TypeText ChrW(945)
End Sub

Private Sub CommandButton100_Click()
    Selection.TypeText ChrW(176)
End Sub

Private Sub CommandButton101_Click()
    Selection.TypeText ChrW(177)
End Sub

Private Sub CommandButton102_Click()
    Selection.TypeText ChrW(2)
End Sub

Private Sub CommandButton103_Click()
    Selection.TypeText ChrW(183)
End Sub

Private Sub CommandButton104_Click()
    Selection.TypeText ChrW(8722)
End Sub

Private Sub CommandButton105_Click()
    Selection.TypeText ChrW(8211)
End Sub

Private Sub CommandButton106_Click()
    Selection.TypeText ChrW(8212)
End Sub

Private Sub CommandButton107_Click()
    Selection.TypeText ChrW(197)
End Sub

Private Sub CommandButton15_Click()
    Selection.TypeText ChrW(959)
End Sub

Private Sub CommandButton2_Click()
    Selection.TypeText ChrW(946)
End Sub

Private Sub CommandButton3_Click()
    Selection.TypeText ChrW(947)
End Sub

Private Sub CommandButton4_Click()
    Selection.TypeText ChrW(948)
End Sub

Private Sub CommandButton5_Click()
    Selection.TypeText ChrW(949)
End Sub

Private Sub CommandButton6_Click()
    Selection.TypeText ChrW(950)
End Sub

Private Sub CommandButton7_Click()
    Selection.TypeText ChrW(951)
End Sub

Private Sub CommandButton8_Click()
    Selection.TypeText ChrW(952)
End Sub

Private Sub CommandButton9_Click()
    Selection.TypeText ChrW(953)
End Sub

Private Sub CommandButton10_Click()
    Selection.TypeText ChrW(954)
End Sub

Private Sub CommandButton11_Click()
    Selection.TypeText ChrW(955)
End Sub

Private Sub CommandButton12_Click()
    Selection.TypeText ChrW(956)
End Sub

Private Sub CommandButton13_Click()
    Selection.TypeText ChrW(957)
End Sub

Private Sub CommandButton14_Click()
    Selection.TypeText ChrW(958)
End Sub

Private Sub CommandButton_Click()
    Selection.TypeText ChrW(959)
End Sub

Private Sub CommandButton16_Click()
    Selection.TypeText ChrW(960)
End Sub

Private Sub CommandButton17_Click()
    Selection.TypeText ChrW(961)
End Sub

Private Sub CommandButton18_Click()
    Selection.TypeText ChrW(963)
End Sub

Private Sub CommandButton19_Click()
    Selection.TypeText ChrW(964)
End Sub

Private Sub CommandButton20_Click()
    Selection.TypeText ChrW(965)
End Sub

Private Sub CommandButton21_Click()
    Selection.TypeText ChrW(966)
End Sub

Private Sub CommandButton22_Click()
    Selection.TypeText ChrW(967)
End Sub

Private Sub CommandButton23_Click()
    Selection.TypeText ChrW(968)
End Sub

Private Sub CommandButton24_Click()
    Selection.TypeText ChrW(969)
End Sub

Private Sub CommandButton51_Click()
    Selection.TypeText ChrW(913)
End Sub

Private Sub CommandButton52_Click()
    Selection.TypeText ChrW(914)
End Sub

Private Sub CommandButton53_Click()
    Selection.TypeText ChrW(9)
End Sub

Private Sub CommandButton54_Click()
    Selection.TypeText ChrW(916)
End Sub

Private Sub CommandButton55_Click()
    Selection.TypeText ChrW(917)
End Sub

Private Sub CommandButton56_Click()
    Selection.TypeText ChrW(918)
End Sub

Private Sub CommandButton57_Click()
    Selection.TypeText ChrW(919)
End Sub

Private Sub CommandButton58_Click()
    Selection.TypeText ChrW(920)
End Sub

Private Sub CommandButton59_Click()
    Selection.TypeText ChrW(921)
End Sub

Private Sub CommandButton60_Click()
    Selection.TypeText ChrW(922)
End Sub

Private Sub CommandButton61_Click()
    Selection.TypeText ChrW(923)
End Sub

Private Sub CommandButton62_Click()
    Selection.TypeText ChrW(924)
End Sub

Private Sub CommandButton63_Click()
    Selection.TypeText ChrW(925)
End Sub

Private Sub CommandButton64_Click()
    Selection.TypeText ChrW(926)
End Sub

Private Sub CommandButton65_Click()
    Selection.TypeText ChrW(927)
End Sub

Private Sub CommandButton66_Click()
    Selection.TypeText ChrW(928)
End Sub

Private Sub CommandButton67_Click()
    Selection.TypeText ChrW(929)
End Sub

Private Sub CommandButton68_Click()
    Selection.TypeText ChrW(931)
End Sub

Private Sub CommandButton69_Click()
    Selection.TypeText ChrW(932)
End Sub

Private Sub CommandButton70_Click()
    Selection.TypeText ChrW(933)
End Sub

Private Sub CommandButton71_Click()
    Selection.TypeText ChrW(934)
End Sub

Private Sub CommandButton72_Click()
    Selection.TypeText ChrW(935)
End Sub

Private Sub CommandButton73_Click()
    Selection.TypeText ChrW(936)
End Sub

Private Sub CommandButton74_Click()
    Selection.TypeText ChrW(937)
End Sub

Private Sub CommandButton998_Click()
    Dialogs(wdDialogInsertSymbol).Show
End Sub

Private Sub CommandButton999_Click()
    Dialogs(wdDialogInsertSymbol).Show
End Sub


Attribute VB_Name = "ref_divide"
Attribute VB_Base = "0{F4A8B6EB-4BCC-4179-9CCE-8B76FEEEBBD7}{FBBE87C7-07E6-480B-85BD-1D837FD30D49}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False




Private Sub CommandButton2_Click()
    Call liyuan_run.tongpeifu
End Sub

Private Sub expand_unit_value_exit(ByVal Cancel As MSForms.ReturnBoolean)

    If IsNumeric(expand_unit_value.Value) Then
        Selection.MoveRight UNIT:=wdWord, count:=CInt(expand_unit_value.Value), Extend:=wdExtend
    Else
        Selection.MoveEndUntil expand_unit_value, 999
        Selection.MoveRight wdCharacter, 1, wdExtend
    End If

End Sub

Private Sub help_button_Click()

    MsgBox "1. Last name end - try BibTex" & vbCrLf & vbCrLf & _
           "2. Last name first " & vbCrLf & "- try BibTex if first name is separated from last name with comma" & vbCrLf & _
           "- try NCBI if there is no comma. " & vbCrLf & vbCrLf & _
           "3. I will work only if full names are *CONSISTENTLY and EXCLUSIVELY* separated by EITHER comma OR semicolon. I will also fail if comma is used to both separate authors and denote first/last names (e.g., something like First, L., Second, L. will get me down). " & vbCrLf & vbCrLf & _
           "4. Entry cannot (1) end with last name and (2) have comma separating out first name *at the same time*. " & vbCrLf & _
           "Comma within the name implies the last name is listed first." & vbCrLf & vbCrLf & "Alway run ""Accept Changes and Remove Fields"" first before using me. I will raise alerts along the way if I detect lurking mark-ups." & vbCrLf & vbCrLf & _
           "If you have no idea why some author names are unrecognized, press ALT+F11 and try take a sneak peak (in ""immediate"" window)." & vbCrLf & vbCrLf & _
                                                                                                                                            "Please, ALWAYS supervise me. I am a machine and make mistakes.", vbInformation, "General Guidelines"

End Sub

Private Sub highlight_button_Click()
    Selection.Range.HighlightColorIndex = IIf(Selection.Range.HighlightColorIndex = wdYellow, wdNoHighlight, wdYellow)
End Sub

Private Sub style_sheet_Click()
    ActiveDocument.FollowHyperlink "http://redmine.mdpi.com/projects/production-editing/wiki/MDPI_Formatting_Rules#References"
End Sub

Private Sub show_hide_Button_Click()

    If show_hide_button.Value = True Then
        ref_divide.Height = 50
        show_hide_button.Caption = "Show"
    Else
        ref_divide.Height = 2
        show_hide_button.Caption = "Hide"
    End If


End Sub

Private Sub UserForm_Initialize()
    Call detect_pitfall_ahead
End Sub

Private Sub bibtex_button_Click()
    If garbled_text_warning(Selection.Text) <> vbOK Then Exit Sub
    Call layout_feifei_liu.sFormatBibtexName
    Selection.Collapse IIf(Selection.Next(wdCharacter, 1) = ";", wdCollapseEnd, wdCollapseStart)
    Call next_button_Click
End Sub

Private Sub ncbi_button_Click()
    If garbled_text_warning(Selection.Text) <> vbOK Then Exit Sub
    'Call layout_feifei_liu.ncbiName
    Call kr_deck.kr_ncbi
    Selection.Collapse IIf(Selection.Next(wdCharacter, 1) = ";", wdCollapseEnd, wdCollapseStart)
    Call next_button_Click
End Sub

Private Sub get_sub_match_Click()

    Call reset_back_color
    If Selection.Next(wdCharacter, 2) = " " And (Selection.Next(wdCharacter, 1) = "," Or Selection.Next(wdCharacter, 1) = ":") Then Selection.Collapse wdCollapseEnd
    If InStr(Selection.Text, ": ") + InStr(Selection.Text, ", ") = 0 Then Selection.Collapse wdCollapseEnd
    Selection.Collapse wdCollapseStart
    With Selection.Find
        .Text = "[!^13]@>([:,;.][ ^13])"
        .format = False
        .MatchWildcards = True
        .Wrap = wdFindStop
        .Execute
        If .Found Then
            Selection.MoveStartWhile (";. ?!:,")
            If InStr(LCase(Selection.Text), "in ") = 1 Then Selection.MoveStart wdCharacter, 3
            Selection.MoveEnd UNIT:=wdCharacter, count:=-2

            'if the selection went over strings like .; and ., then revert back
            Dim A As Long, B As Long
            A = InStr(Selection.Text, ".;")
            B = InStr(Selection.Text, ".,")

            If A = 0 Then
                If B > 0 Then Selection.MoveEnd wdCharacter, B - Len(Selection.Text)
            Else
                If B = 0 Then
                    Selection.MoveEnd wdCharacter, A - Len(Selection.Text)
                Else
                    Selection.MoveEnd wdCharacter, layout_paragraphs.min(A, B) - Len(Selection.Text)
                End If
            End If
            '''

            If InStr(Selection.Text, ";") + InStr(Selection.Text, ". ") > 0 Then get_sub_match.BackColor = 255

            Call detect_pitfall_ahead
        Else
            Selection.Collapse wdCollapseEnd
        End If

    End With

End Sub

Private Sub expand_selection_button_Click()
    On Error GoTo err:

    With Selection

        If .Next(wdCharacter, 1) = ChrW(13) Then
            .Next(wdParagraph, 1).Select
            .Collapse wdCollapseStart
        Else
            .MoveEnd wdCharacter, 1
        End If

        While .Next(wdCharacter, 1).Previous(wdCharacter, 1).Italic = .Next(wdCharacter, 1).Font.Italic And Asc(.Next(wdCharacter, 1)) <> 13
            .MoveEnd wdCharacter, 1
        Wend

    End With

    Exit Sub
err:
    Debug.Print "I think you blurted through the end of document.." & err.number & err.Description
End Sub

Private Sub journal_meta_Click()

    If Len(Selection.Text) - Len(Replace(Selection.Text, ",", "")) < 2 Then
        MsgBox "I don't think this is journal metadata... check again please.", vbCritical, "Something wrong..."
        Exit Sub
    ElseIf Len(Selection.Text) - Len(Replace(Selection.Text, ",", "")) > 2 Or Not IsNumeric(Mid(Selection.Text, InStr(Selection.Text, ",") - 1, 1)) Then
        If MsgBox("This doesn't quite look like journal metadata ... I can try if you insist. Continue? ", vbOKCancel, "Are you sure?") = vbCancel Then Exit Sub
    End If
    Call layout_feifei_liu.FormatYearVolPage_One
    'revise further to adjust when journal name is taken as part

End Sub

Private Sub next_button_Click()

    Call reset_back_color
    Call Ad_layout_validator.finish_validate_command_ui_change
    Selection.Collapse wdCollapseEnd
    With Selection.Find
        .Text = "[!^13]@>([;.\?\!][ ^13])"
        .format = False
        .MatchWildcards = True
        .Wrap = wdFindStop
        .Execute
        If .Found Then
            Selection.MoveStartWhile (";. ?!:,")
            Selection.MoveEnd UNIT:=wdCharacter, count:=-2
            If InStr(Selection.Text, "). ") > 0 Then Selection.MoveEnd wdCharacter, InStr(Selection.Text, "). ") - Len(Selection.Text)
            Select Case parse_ref_part
            End Select
            Call detect_pitfall_ahead
        End If

    End With
End Sub

Private Sub italic_button_Click()

    If Selection.Next(wdCharacter, 1) = "." Then Selection.MoveEndWhile (".")
    Selection.Font.Italic = Not Selection.Font.Italic
    'Call next_button_Click
    If Selection.Font.Italic And Selection.Next(wdCharacter, 2).Font.Italic And Selection.Next(wdCharacter, 1) = " " Then Selection.Next(wdCharacter, 1).Font.Italic = True
End Sub

Function parse_ref_part()

    Dim RegEx
    Set RegEx = CreateObject("vbscript.regexp")
    Dim i As Integer

    If Selection.Next(wdCharacter, 1) = "." Then
        '    refstr = "Wu, H.; Li, X.; Wu, D" & "."
        Dim au_names() As String

        au_names = Split(Selection.Text & ".", "; ")
        With RegEx
            .Global = True
            .Pattern = "[A-Za-z'" & ChrW(8217) & "\s\-]+,\s([A-Z]\.-?)+(,\sJr\.|,\sI{2,3})?"
            'consider common suffix: Jr.,
            'does not work for II, III, because the author fetching will ternimate after III; , so the au_names does not end with . and not be processed
        End With

        'this FOR should be merge with the later IF to have better coding structure
        For i = 0 To UBound(au_names)            'Each au_name In au_names
            If RegEx.Execute(au_names(i)).count <> 1 Then
                If Not (i = 10 And UBound(au_names) = 10 And au_names(i) = "et al.") Then
                    Debug.Print au_names(i) & "not a valid name"
                    GoTo not_valid_names
                End If
            ElseIf RegEx.Execute(au_names(i))(0) <> au_names(i) Then
                If Not (i = 10 And UBound(au_names) = 10 And au_names(i) = "et al.") Then
                    Debug.Print au_names(i) & "not a valid name"
                    GoTo not_valid_names
                End If
            End If
        Next

        'accept only 10 persons and should end with et al. in the 11th
        If UBound(au_names) >= 10 Then
            If au_names(10) <> "et al." Or UBound(au_names) > 10 Then
                Debug.Print "too many authors? (" & UBound(au_names) + 1 & ")"
                GoTo not_valid_names
            End If
        End If

        next_button.BackColor = 65280
        parse_ref_part = "valid_author_names"
        Debug.Print "valid_author_names"
        Set sql = Nothing
        Set RegEx = Nothing
        Exit Function
    End If

not_valid_names:
    'NCBI names?

    'ReDim au_names(0)
    au_names_n = Split(Selection.Text, ", ")
    With RegEx
        .Global = True
        .Pattern = "[A-Za-z'" & ChrW(8217) & "\-]+\s[A-Z]+"
    End With

    For Each au_name In au_names_n
        If RegEx.Execute(au_name).count <> 1 Then
            GoTo not_valid_ncbi_names
        ElseIf RegEx.Execute(au_name)(0) <> au_name Then
            GoTo not_valid_ncbi_names
        End If
    Next

    ncbi_button.BackColor = 65280
    parse_ref_part = "ncbi_author_names"
    Debug.Print "ncbi_author_names"
    Set sql = Nothing
    Set RegEx = Nothing
    Exit Function

not_valid_ncbi_names:

    With RegEx
        .Global = True
        .Pattern = "(19|20)\d{2}\s?,\s?[\d\(\)]+\s?,[\s\d:\-" & ChrW(8211) & "]+"
    End With
    If Not RegEx.test(Selection.Text) Then GoTo not_valid_journal_meta

    journal_meta.BackColor = 65280
    journal_meta.Caption = RegEx.Execute(Selection.Text)(0)
    parse_ref_part = "journal_meta"
    Debug.Print "journal_meta"
    Set sql = Nothing
    Set RegEx = Nothing
    Exit Function

not_valid_journal_meta:

    parse_ref_part = "not identified"
    Debug.Print "not identified"
    Set sql = Nothing
    Set RegEx = Nothing
    next_button.BackColor = 65535
    Set sql = Nothing
    Set RegEx = Nothing

End Function

Private Sub reset_back_color()

    With ref_divide
        .ncbi_button.BackColor = -2147483633
        .get_sub_match.BackColor = -2147483633
        .next_button.BackColor = -2147483635
        .journal_meta.BackColor = -2147483633
        .journal_meta.Caption = "YYYY, V, PP" & ChrW(8211) & "PP"
    End With

End Sub

Private Sub detect_pitfall_ahead()

    Dim Rng As Range

    With alert_label
        .Caption = ""
        .BackColor = -2147483633
        If ActiveDocument.TrackRevisions = True Then .Caption = .Caption & "Tracking!" & vbCrLf

        Set Rng = Selection.Range
        On Error GoTo err
        Rng.SetRange Selection.Start, Selection.Next(wdParagraph, 2).End
        GoTo back:
err:
        Rng.SetRange Selection.Start, ActiveDocument.Range.End
back:
        If Rng.Fields.count > 0 Then .Caption = .Caption & "Field!" & vbCrLf
        If Rng.Revisions.count > 0 Then .Caption = .Caption & "Revision!" & vbCrLf
        If Rng.comments.count > 0 Then .Caption = .Caption & "Comment!"

        If .Caption <> "" Then .BackColor = 255
    End With


End Sub

Private Function garbled_text_warning(refstr As String)

    If InStr(refstr, ";") <> 0 Then
        refparts = Split(refstr, ";")
        comma_count = Len(refparts(0)) - Len(Replace(refparts(0), ",", ""))
        For j = 1 To UBound(refparts)
            If comma_count <> Len(refparts(j)) - Len(Replace(refparts(j), ",", "")) Then
                ref_divide.alert_label.BackColor = 255
                garbled_text_warning = MsgBox(">_<# The text looks somewhat garbled... I may make a mistake. Continue?", vbOKCancel, "@#$%^&|>!~..")
                Set ref_parts = Nothing
                Exit Function
            End If
        Next j
        Set ref_parts = Nothing
    End If

    garbled_text_warning = vbOK
End Function

Private Sub CommandButton1_Click()

    ActiveDocument.FollowHyperlink "http://search.crossref.org/" & URLEncode(Selection.Text), "", False, True

End Sub

Public Function URLEncode(StringToEncode As String, Optional _
                                                   UsePlusRatherThanHexForSpace As Boolean = False) As String

    Dim TempAns As String
    Dim CurChr As Integer
    CurChr = 1
    Do Until CurChr - 1 = Len(StringToEncode)
        Select Case Asc(Mid(StringToEncode, CurChr, 1))
        Case 48 To 57, 65 To 90, 97 To 122
            TempAns = TempAns & Mid(StringToEncode, CurChr, 1)
        Case 32
            If UsePlusRatherThanHexForSpace = True Then
                TempAns = TempAns & "+"
            Else
                TempAns = TempAns & "%" & Hex(32)
            End If
        Case Else
            TempAns = TempAns & "%" & _
                      format(Hex(Asc(Mid(StringToEncode, _
                                         CurChr, 1))), "00")
        End Select

        CurChr = CurChr + 1
    Loop

    URLEncode = TempAns
End Function



Attribute VB_Name = "layout_document_properties"
Public Sub WriteProp(sPropName As String, sValue As String, _
                     Optional lType As Long = msoPropertyTypeString)

    'In the above declaration, "Optional lType As Long = msoPropertyTypeString" means
    'that if the Document Property's Type is Text, we don't need to include the lType argument
    'when we call the procedure; but if it's any other Prpperty Type (e.g. date) then we do

    Dim bCustom As Boolean

    On Error GoTo ErrHandlerWriteProp

    'Try to write the value sValue to the custom documentproperties
    'If the customdocumentproperty does not exists, an error will occur
    'and the code in the errorhandler will run
    ActiveDocument.BuiltInDocumentProperties(sPropName).Value = sValue
    'Quit this routine
    Exit Sub


Proceed:
    'We know now that the property is not a builtin documentproperty,
    'but a custom documentproperty, so bCustom = True
    bCustom = True

Custom:
    'Try to set the value for the customproperty sPropName to sValue
    'An error will occur if the documentproperty doesn't exist yet
    'and the code in the errorhandler will take over
    ActiveDocument.CustomDocumentProperties(sPropName).Value = sValue
    Exit Sub

AddProp:
    'We came here from the errorhandler, so know we know that
    'property sPropName is not a built-in property and that there's
    'no custom property with this name
    'Add it
    On Error Resume Next
    ActiveDocument.CustomDocumentProperties.Add name:=sPropName, _
                                                LinkToContent:=False, Type:=lType, Value:=sValue

    If err Then
        'If we still get an error, the value isn't valid for the Property Type
        'e,g an invalid date was used
        'Debug.Print
        MsgBox "The Property " & Chr(34) & _
               sPropName & Chr(34) & " couldn't be written, because " & _
               Chr(34) & sValue & Chr(34) & _
               " is not a valid value for the property type"
    End If

    Exit Sub

ErrHandlerWriteProp:
    Select Case err
    Case Else
        'Clear the error
        err.Clear
        'bCustom is a boolean variable, if the code jumps to this
        'errorhandler for the first time, the value for bCustom is False
        If Not bCustom Then
            'Continue with the code after the label Proceed
            Resume Proceed
        Else
            'The errorhandler was executed before because the value for
            'the variable bCustom is True, therefor we know that the
            'customdocumentproperty did not exist yet, jump to AddProp,
            'where the property will be made
            Resume AddProp
        End If
    End Select

End Sub

'We could call the above procedure like this:

Sub test()
    'Author is a built-in property
    Call WriteProp(sPropName:="Author", sValue:="William Shakespeare")

    'Date Updated is a custom document property
    Call WriteProp(sPropName:="Date Updated", sValue:="11 Mar 2001", _
                   lType:=msoPropertyTypeDate)
End Sub

'Reading Document Properties
'The same principle can be used when reading Document Properties:

Function ReadProp(sPropName As String) As Variant

    Dim bCustom As Boolean
    Dim sValue As String

    On Error GoTo ErrHandlerReadProp
    'Try the built-in properties first
    'An error will occur if the property doesn't exist
    sValue = ActiveDocument.BuiltInDocumentProperties(sPropName).Value
    ReadProp = sValue
    Exit Function

ContinueCustom:
    bCustom = True

Custom:
    sValue = ActiveDocument.CustomDocumentProperties(sPropName).Value
    ReadProp = sValue
    Exit Function

ErrHandlerReadProp:
    err.Clear
    'The boolean bCustom has the value False, if this is the first
    'time that the errorhandler is runned
    If Not bCustom Then
        'Continue to see if the property is a custom documentproperty
        Resume ContinueCustom
    Else
        'The property wasn't found, return an empty string
        ReadProp = ""
        Exit Function
    End If

End Function

'We could call the function like this:

Sub test2()

    Dim PropVal As String

    PropVal = ReadProp("Author")
    MsgBox PropVal

    PropVal = ReadProp("Date Updated")
    MsgBox PropVal

End Sub



Attribute VB_Name = "layout_feifei_liu"
Option Explicit
Dim i As Integer

Sub feifei_run(ByVal control As IRibbonControl)
    Application.ScreenUpdating = False
    Select Case control.id
    Case "layout_deck_una_magic_quick"
    
        ActiveDocument.TrackRevisions = False    ' this is very important - instant revision will immediately alter the text and break subsequent search
        With ActiveWindow.View
            .ShowRevisionsAndComments = True
            .RevisionsView = wdRevisionsViewFinal
        End With
        
        If ref_divide.Visible = True Then
            ref_divide.Hide
        Else
            Load ref_divide
            With ref_divide
                .StartUpPosition = 0
                .Top = Application.Top + 25
                .Left = Application.Left + Application.Width * 0.98 - .Width
                .Show
            End With
        End If
                
    Case "layout_deck_una_magic"

        ActiveDocument.TrackRevisions = False    ' this is very important - instant revision will immediately alter the text and break subsequent search
        With ActiveWindow.View
            .ShowRevisionsAndComments = True
            .RevisionsView = wdRevisionsViewFinal
        End With
    
        Load ref_divide
        With ref_divide
…