kerrypnx
11/6/2018 - 7:56 AM

草稿

revise 11-6

Sub detectBallotBox()
Dim i As Integer
Dim str
Dim arr As String
arr = "9633,9744"
str = Split(arr, ",")
i = 0
Do While (i < 2)
    With Selection.Find
        .ClearFormatting
        .Text = ChrW(CInt(str(i)))
        .MatchWildcards = False
        Do
        .Execute
        If Not .Found Then
        Exit Do
        Else
            If InputBox("Is this Ballot Box?", "Replace Ballot Box", "yes", 300, 300) = "yes" Then
                    Selection.Text = "&#x2003;&#x25A1;"
                    Else
                    Selection.MoveRight wdCharacter, 1
            End If
        End If
        Loop
    End With
    i = i + 1
 Loop
End Sub
Sub putEquationIntoTable()
With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .MatchWildcards = False
    Do
        .Execute
        If Not .Found Then
            Exit Do
        Else
            
            Dim aimT As String
            
            
            aimT = Selection.Text
            Selection.Range.Delete
            Selection.Range.Font.name = "Palatino Linotype"
            Selection.TypeText aimT
        End If
    Loop
End With
End Sub
Function q(str As String)
    Dim reg As New RegExp
    reg.Pattern = "text=" + ChrW(34) + "(.+?)" + ChrW(34)
    reg.Global = True
    Dim match
    Set match = reg.Execute(str)
    q = match(0).SubMatches(0)
End Function
Sub putEquationIntoTablea()
    Dim myMath As OMath
    Dim myField As Field
    For Each myMath In ActiveDocument.OMaths
    
        myMath.Range.Select
        If FunctionGroup.isParagraph(Selection.Paragraphs(1).Range.Text) = False Then
           Call formatEquation
        End If
    Next
    For Each myField In ActiveDocument.Fields
        myField.Select
        If Selection.Type = 7 Then
          Call formatEquation
        End If
    Next
End Sub
Function formatEquation()
        If Selection.Information(wdWithInTable) Then
            Selection.Tables(1).Select
             Selection.Style = ActiveDocument.Styles("MDPI_equationFram")
            Else
            If FunctionGroup.isParagraph(Selection.Paragraphs(1).Range.Text) = False Then
            Selection.Cut
            Call EquationFrameNo
            Selection.MoveDown wdLine, 1
            End If
        End If
End Function
Sub qwr()
    Dim i As Integer
    i = 1
    Do While i < 198
        Selection.HomeKey wdLine
        Selection.TypeText CStr(i) + "!"

        Selection.MoveDown wdParagraph
        i = i + 1
    Loop
End Sub

Sub Macro1()
'
' Macro1 Macro
'
Selection.InsertCrossReference ReferenceType:=wdRefTypeBookmark, ReferenceKind:= _
                                       wdNumberNoContext, ReferenceItem:="refTemp" & strtemp, _
                                       InsertAsHyperlink:=True
                                       
    Selection.InsertCrossReference ReferenceType:="Numbered item", _
        ReferenceKind:=wdNumberRelativeContext, ReferenceItem:="1", _
        InsertAsHyperlink:=True, IncludePosition:=False, SeparateNumbers:=False, _
        SeparatorString:=" "
End Sub
Sub Macro2()
'
    Selection.Orientation = wdTextOrientationDownward
    Selection.Orientation = wdTextOrientationUpward
    Selection.Orientation = wdTextOrientationHorizontal
    Selection.Orientation = wdTextOrientationDownward
    Selection.Orientation = wdTextOrientationUpward
    Selection.Orientation = wdTextOrientationHorizontal
    Selection.SelectCell
    Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
    Selection.Cells.VerticalAlignment = wdCellAlignVerticalTop
    Selection.SelectCell
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    Selection.Cells.VerticalAlignment = wdCellAlignVerticalTop
End Sub
Sub Macro3()
Dim objRange As Range
Dim objEq As OMath
 
Set objRange = Selection.Range
objRange.Text = "Celsius = (5/9)(Fahrenheit - 32)"
Set objRange = Selection.OMaths.Add(objRange)
Set objEq = objRange.OMaths(1)
objEq.BuildUp
End Sub
Sub Macro4()
    
    With Selection.Find
        .Text = "\*[A-Z][!^13]@. "
        .Replacement.Text = ""
        .MatchWildcards = True
        Do
            DoEvents
            .Execute
            If .Found Then
                If InputBox("yes", "yes", "yes", 300, 300) = "yes" Then
                    Dim myrange  As Range
                    Set myrange = ActiveDocument.Range(Selection.Range.Start + 1, Selection.Range.End - 2)
                    myrange.Select
                    Dim str, first, last, name As String
                    Dim arr, brr
                    str = Selection.Text
                    arr = Split(Selection.Text, "; ")
                    Dim i As Integer
                    i = 0
                    name = ""
                    Do While i < UBound(arr) + 1
                        brr = Split(arr(i), ", ")
                        first = FunctionGroup.convertUpper(CStr(brr(0)))
                        
                        last = Left(brr(1), "1") + "."
                        
                        If InStr(brr(1), " ") > 0 Then
                            crr = Split(brr(1), " ")
                            last = ""
                            
                            For j = LBound(crr) To UBound(crr)
                                
                                last = last + Left(crr(j), 1) + "."
                            Next
                            
                            If j = UBound(crr) Then
                                name = name + first + ", " + last
                            Else
                                name = name + first + ", " + last + "; "
                            End If
                        Else
                            name = name + first + ", " + last + "; "
                        End If
                        
                        
                        i = i + 1
                    Loop
                Else
                    Selection.MoveRight wdCharacter, 1
                    name = ""
                End If
            Else
                Exit Do
            End If
            Selection.Text = name
            Selection.MoveRight wdCharacter, 1
        Loop
    End With
    
End Sub
Sub laTexRefOrder()
Dim dict
Dim i, last_called_ref As Integer
i = 1: last_called_ref = 0
Set dict = CreateObject("Scripting.Dictionary")
With Selection.Find
    .Text = "\\bibitem\[?@\]"
    .MatchWildcards = True
    Do
    DoEvents
    .Execute
        If .Found Then
            Selection.Collapse wdCollapseEnd
            Selection.MoveEndUntil "{"
            Selection.MoveRight wdCharacter, 1
            Selection.MoveEndUntil "}"
            dict.Add Trim(Selection.Text), CStr(i)
        Else
            Exit Do
        End If
        i = i + 1
        Selection.MoveRight wdCharacter, 1
    Loop
    
End With

Selection.HomeKey wdStory
With Selection.Find
    .Text = "\\cit[a-z]@\{"
    .MatchWildcards = True
    .Replacement.Text = ""
    Do
    DoEvents
    .Execute
        If Not .Found Then
            Exit Do
        Else
            Selection.Collapse wdCollapseEnd
            Selection.MoveEndUntil "}"
            If Left(Selection.Paragraphs(1).Range.Text, "1") = "%" Then
                GoTo kr
            End If
            Dim arr
            arr = Split(Selection.Text, ",")
            Dim j As Integer
            Dim aimT As String
            aimT = ""
            For j = LBound(arr) To UBound(arr)
                If aimT > dict(Trim(arr(j))) Then
                    aimT = dict(Trim(arr(j))) + "," + aimT
                Else
                    aimT = aimT + dict(Trim(arr(j))) + ","
                End If
            Next
            last_called_ref = parse_ref_call(aimT, last_called_ref)
        
        End If
kr:
        Selection.MoveRight wdCharacter, 1
    Loop

End With
    If ActiveDocument.comments.count = 0 Then
        MsgBox "No problem was detected"
    End If
End Sub
Function parse_ref_call(AnyStr As String, last_call As Integer)
    Dim i As Integer
    Dim RegEx, dict
    Set RegEx = CreateObject("vbscript.regexp")
    Set dict = CreateObject("Scripting.Dictionary") 'prepare look-up hash pair for valid ranges, e.g., 8-14, when checking sequence the code knows to look for  after 8
    Set sql = RegEx.Execute(Selection.Text)      ' find en dash connected ranges

    With RegEx
        .Global = True
        .Pattern = "\d+"
    End With
    Set sql = RegEx.Execute(AnyStr)

    For i = 0 To sql.count - 1

        If Val(sql(i)) > last_call + 1 Then
            Selection.comments.Add Range:=Selection.Range, Text:="incorrect ref order, " & sql(i) & " detected after " & last_call & ". You jumped the numbers in between."
        Else
            If dict.Exists(CStr(sql(i))) Then    'cstr ensures the sql(i) is converted from IMatch2 to string, therefore returns dict look up value
                If Val(dict(CStr(sql(i)))) > last_call Then ' do not merge this if with the parent if. I am worried the dict(key) call will automatically add entry and mess up the conditional, even with ordered AND
                    last_call = Val(dict(CStr(sql(i))))
                End If
            Else
                If Val(sql(i)) > last_call Then
                    last_call = Val(sql(i))
                End If
            End If
        End If
        
        If i + 1 <= sql.count - 1 Then
            If Val(sql(i)) >= Val(sql(i + 1)) Then
                Selection.comments.Add Range:=Selection.Range, Text:="detected " & sql(i) & " before " & sql(i + 1) & ". This is wrong order."
            End If
        End If
    Next i

    parse_ref_call = last_call
    Set RegEx = Nothing
    Set dict = Nothing

End Function
Sub ottttttttttttttttt()

End Sub

Sub oneKeyPublish()
    publishDate
     publishFooterHeader
     publishDate
     detectCopyright
End Sub
Sub publishDate()

With Selection.Find
    .ClearFormatting
    .Text = "; Published:"
    .MatchWildcards = False
    .Execute
End With
    With Selection
        .Collapse wdCollapseEnd
        .MoveEndUntil ChrW(13)
        .TypeText " " + IIf(Left(day(Date), 1) = "0", Left(day(Date), 1), Right(day(Date), 1)) + " " + FunctionGroup.convertYear(CStr(Month(Date))) + " " + CStr(year(Date))
    End With
End Sub
Sub publishFooterHeader()
Selection.HomeKey wdStory
Dim doi, aimT, articleNum, volume As String
'If ActiveWindow.View.SplitSpecial <> wdPaneNone Then ActiveWindow.Panes(2).Close
'doi = InputBox("please insert doi number", "get doi number", , 300, 300)
doi = "doi:10.3390/ijms19113413"
Dim reg As New RegExp
Dim matches
With reg
    .Global = True
    .Pattern = "\d{8}$"
Set matches = reg.Execute(doi)
End With
aimT = matches(0)

If Left(volume, 1) = "0" Then
    volume = Right(volume, 1)
Else
    volume = Left(aimT, 2)
End If
articleNum = Right(aimT, 4)

'MsgBox year(Date)
'MsgBox Month(Date)
'MsgBox day(Date)

WordBasic.ViewFooterOnly

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

WordBasic.ViewheaderOnly
ActiveWindow.ActivePane.View.NextHeaderFooter

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

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub

Sub detectCopyright()
Dim aimT, testT As String
testT = "by the authors. Submitted for possible open access"
    With Selection.Find
        .ClearFormatting
        .Text = ChrW(169) & " 2"
        .Replacement.Text = ""
        .Replacement.ClearFormatting
        .Execute
    End With
aimT = Selection.Paragraphs(1).Range.Text
If InStr(aimT, testT) = 0 Then
    Selection.Collapse wdCollapseEnd
    MsgBox "copyright incorrect"
End If
End Sub
Sub suppleLink()
Dim doi, volume, aimT
getfootertext = ActiveDocument.Sections(1).Footers(wdHeaderFooterFirstPage).Range.Text
doi = Mid(getfootertext, InStr(getfootertext, ";") + 1, InStr(getfootertext, "www") - InStr(getfootertext, ";"))
Dim reg As New RegExp
Dim matches
With reg
    .Global = True
    .Pattern = "\d{8}"
Set matches = reg.Execute(doi)
End With
aimT = matches(0)

If Left(volume, 1) = "0" Then
    volume = Right(volume, 1)
Else
    volume = Left(aimT, 2)
End If

issue = Mid(aimT, 2, 2)

articleNum = Right(aimT, 4)

    Selection.Text = "http://www.mdpi.com/" + FunctionGroup.getISSN() + "/" + volume + "/" + issue + "/" + articleNum
End Sub
Sub deleteChicagoNameYear()
Call kr_deck.aselect_whole_reference
Dim paraNum, i As Integer
i = 0
paraNum = Selection.Paragraphs.count
Selection.Collapse wdCollapseStart
Do While (i < paraNum)
    Selection.MoveEndUntil ")"
    Selection.MoveRight wdCharacter, 2, wdExtend
    Selection.Delete
    Selection.Move 4
    i = i + 1
Loop
End Sub


Sub soushou()
Dim wrd As Range
Dim searT, url As String
searT = ""
For Each wrd In Selection.Range.Words
    searT = searT + "+" + Trim(wrd.Text)
Next
 searT = Right(searT, Len(searT) - 1)
url = "https://www.google.com.hk/search?q=" + searT

Shell ("C:\Program Files (x86)\Google\Chrome\Application\Chrome.exe -url " + url)

End Sub
Sub qwwqer()
   If DateValue("2010/10/4") > DateValue("2010/8/19") Then
    MsgBox "s"
   End If
End Sub
Sub ooooppppqqq()
MsgBox ActiveDocument.Range.Information(wdNumberOfPagesInDocument)
End Sub
Sub detectEmailCount()
Selection.HomeKey wdStory
With Selection.Find
    .ClearFormatting
    .Text = "Received: "
    .MatchWildcards = True
    .Replacement.Text = ""
    .Execute
End With
Dim myrange As Range
Set myrange = ActiveDocument.Range(ActiveDocument.Paragraphs(3).Range.End, Selection.Range.Start)
myrange.Select
If FunctionGroup.emailCount(myrange.Text) <> FunctionGroup.authorCount(ActiveDocument.Paragraphs(3).Range.Text) Then
    myrange.comments.Add myrange, "The number of authors does not match the number of email"
End If
End Sub
Sub timeOrder()
Selection.HomeKey wdStory
With Selection.Find
    .ClearFormatting
    .Text = "Received: "
    .MatchWildcards = True
    .Replacement.Text = ""
    .Execute
End With
Selection.Paragraphs(1).Range.Select
If InStr(Selection.Text, "Received") > 0 And InStr(Selection.Text, "Accepted") > 0 And InStr(Selection.Text, "Published") > 0 Then
    arr = Split(Selection.Text, "; ")
    If UBound(arr) <> 2 Then
        Selection.Range.HighlightColorIndex = wdRed
        Selection.comments.Add Selection.Range, "Please check if date is missing"
        Exit Sub
    End If
    
    Received = Right(arr(0), Len(arr(0)) - InStr(arr(0), ": ") - 1)
    Accepted = Right(arr(1), Len(arr(1)) - InStr(arr(1), ": ") - 1)
    Published = Right(arr(2), Len(arr(2)) - InStr(arr(2), ": ") - 1)
    
    If DateValue(Received) < DateValue(Accepted) And DateValue(Accepted) < DateValue(Published) Then
        
    Else
        Selection.Range.HighlightColorIndex = wdRed
        Selection.comments.Add Selection.Range, "Please check if date is missing"
        Exit Sub
    End If
    
Else
    Selection.Range.HighlightColorIndex = wdRed
    Selection.comments.Add Selection.Range, "Please check if date is missing"
    Exit Sub
End If

End Sub
Sub ppoo()
    If DateValue("12 July 2018") > DateValue("13 December 2018") Then
        MsgBox "s"
    End If
End Sub
Sub getsss()
  Dim i As Long, url As String
  Dim S
  Dim rxp As String
  Dim getId As String
  Dim xhttp As Object, rx As Object, maches As Object
  Set xhttp = CreateObject("MSXML2.XMLHTTP")
  
    url = "https://redmine.mdpi.com/projects/production-editing/search?utf8=%E2%9C%93&issues=1&q=religions-354795"
 
    xhttp.Open "get", url, False
    delay (3000)
    xhttp.Send
    delay (300)
        Do While xhttp.ReadyState <> 4
        DoEvents
    Loop

    S = xhttp.ResponseText
    Selection.TypeText S
    
End Sub
Sub Main()
    Dim strText As String
    Dim strCookie As String
    
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Option(6) = False ' 禁止重定向,以获取原网页信息
        .Open "GET", "https://redmine.mdpi.com/projects/production-editing/search?utf8=%E2%9C%93&issues=1&q=religions-354795", False
        .Send
        strText = .GetAllResponseHeaders '获取所有的回应头信息
       Selection.TypeText strText '在立即窗口里查看头信息
      '取出Cookie值
    End With
    
    '在同一个winhttp对象里能保留cookie,为了体现设置cookie的作用,启用一个新的winhttp对象
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", "http://www.gzgczj.com:8080/costRegulatory/project.do?method=showProjectList&isVisitor=1&f_id=11011&t1413902083242", False
        .SetRequestHeader "Referer", "http://www.gzgczj.com:8080/costRegulatory/user.do?method=changeIndex&fareaId=1"
        .SetRequestHeader "Cookie", strCookie '模拟Cookie
        .Send
        strText = .ResponseText
        Debug.Print strText
    End With
End Sub

Option Explicit

Option Explicit

Sub Test_ehawaii_gov()

    Dim sUrl, sRespHeaders, sRespText, aSetHeaders, aList

    ' example for https://energy.ehawaii.gov/epd/public/energy-projects-map.html
    ' get cookies
    sUrl = "https://redmine.mdpi.com/projects/production-editing/search?utf8=%E2%9C%93&issues=1&q=religions-354795"
    XmlHttpRequest "GET", sUrl, Array(), "", sRespHeaders, sRespText
    ParseResponse "^Set-(Cookie): (\S*?=\S*?);[\s\S]*?$", sRespHeaders, aSetHeaders
    ' get projects list
    sUrl = "https://energy.ehawaii.gov/epd/public/energy-projects-list.json?sEcho=2&iColumns=5&sColumns=&iDisplayStart=1&iDisplayLength=0&mDataProp_0=0&mDataProp_1=1&mDataProp_2=2&mDataProp_3=3&mDataProp_4=4&sSearch=&bRegex=false&sSearch_0=&bRegex_0=false&bSearchable_0=true&sSearch_1=&bRegex_1=false&bSearchable_1=true&sSearch_2=&bRegex_2=false&bSearchable_2=true&sSearch_3=&bRegex_3=false&bSearchable_3=true&sSearch_4=&bRegex_4=false&bSearchable_4=true&iSortCol_0=0&sSortDir_0=asc&iSortingCols=1&bSortable_0=true&bSortable_1=true&bSortable_2=true&bSortable_3=true&bSortable_4=true"
    XmlHttpRequest "GET", sUrl, aSetHeaders, "", "", sRespText
    ' parse project names
    ParseResponse "\[""([\s\S]*?)""", sRespText, aList
    Debug.Print Join(aList, vbCrLf)

End Sub

Sub XmlHttpRequest(sMethod, sUrl, aSetHeaders, sPayload, sRespHeaders, sRespText)
    Dim aHeader
    With CreateObject("MSXML2.ServerXMLHTTP")
        .SetOption 2, 13056 ' SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS
        .Open sMethod, sUrl, False
        For Each aHeader In aSetHeaders
            .SetRequestHeader aHeader(0), aHeader(1)
        Next
        .Send (sPayload)
        sRespHeaders = .GetAllResponseHeaders
        sRespText = .ResponseText
    End With
End Sub

Sub ParseResponse(sPattern, sResponse, aData)
    Dim oMatch, aTmp, sSubMatch
    aData = Array()
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .Pattern = sPattern
        For Each oMatch In .Execute(sResponse)
            If oMatch.SubMatches.count = 1 Then
                PushItem aData, oMatch.SubMatches(0)
            Else
                aTmp = Array()
                For Each sSubMatch In oMatch.SubMatches
                    PushItem aTmp, sSubMatch
                Next
                PushItem aData, aTmp
            End If
        Next
    End With
End Sub

Sub PushItem(aList, vItem)
    ReDim Preserve aList(UBound(aList) + 1)
    aList(UBound(aList)) = vItem
End Sub
Sub Macro5()
i = 1
Do While (i < 150)
Do
Selection.MoveEndUntil ","

If existTitle(Selection.Text) = False Then
oriL = Len(Selection.Text)
Selection.MoveRight wdCharacter, 2, wdExtend
Selection.MoveEndUntil ","
 nowL = Len(Selection.Text)
 
Else
   
    Selection.MoveLeft wdCharacter, nowL - oriL, wdExtend
    Selection.MoveRight wdCharacter, 1, wdExtend
    If InputBox("Is this ncbi?", "NCBI", "yes", 300, 300) = "yes" Then
    Call layout_feifei_liu.sFormatBibtexName
    End If
    Exit Do
End If
Loop
Selection.Move 4
i = i + 1
Loop
End Sub
Function existTitle(str As String) As Boolean

     Dim reg As Object
    Set reg = CreateObject("VBScript.Regexp")
    Dim is_exist As Boolean
    With reg
        .Global = True
        .Pattern = " \w+ "
        is_exist = .test(str)
    End With
    existTitle = is_exist
End Function
Sub dectectSectionCite()
'
With Selection.Find
    .ClearFormatting
    .Replacement.Text = ""
    .Text = "Section [0-9]"
    .MatchWildcards = True
    .Execute
    Selection.MoveEndUntil " "
    arr = Split(Selection, " ")
    T = arr(1)

        If existSection(CStr(T), FunctionGroup.dotCount(Selection.Text) + 1) = False Then
        End If
        
End With
'
    
End Sub
Function existSection(str As String, level As Integer) As Boolean
existSection = False
    With ActiveDocument.Content.Find
            .Text = str
            .MatchWildcards = False
            .ParagraphFormat.OutlineLevel = level
            .Execute
            If .Found Then
                existSection = True
            End If
        End With
End Function
Sub Macro7()
'
' Macro7 Macro
'
'
    With Selection.HeaderFooter.PageNumbers
        .NumberStyle = wdPageNumberStyleArabic
        .HeadingLevelForChapter = 0
        .IncludeChapterNumber = False
        .ChapterPageSeparator = wdSeparatorHyphen
        .RestartNumberingAtSection = True
        .StartingNumber = 11
    End With
End Sub
Sub detectSectionTitleOrder(ByVal control As IRibbonControl)
    Call sectionTitleOrder(1)
    Call sectionTitleOrder(2)
    Call sectionTitleOrder(3)
End Sub
Sub sectionTitleOrder(level As Integer)
Dim lastCall, selectNum As Integer
    lastCall = 0
    Selection.HomeKey wdStory
    With Selection.Find
        .ClearFormatting
        .Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = False
        .Replacement.Text = ""
        .ParagraphFormat.OutlineLevel = level
        Do
            .Execute
            
            If Not .Found Then
                Exit Do
            Else
            
                If FunctionGroup.isSectionTitle(Selection.Text) Then
                    selectNum = CInt(sectionNum(Selection.Text))
                    If selectNum > lastCall Then
                    
                        If selectNum - lastCall = 1 Then
                        
                        Else
                            Selection.Range.HighlightColorIndex = wdYellow
                        End If
                        
                        lastCall = selectNum
                        Selection.Collapse wdCollapseEnd
                    Else
                        If selectNum = 1 Then
                            lastCall = 1
                            Selection.Collapse wdCollapseEnd
                        Else
                            Selection.Range.HighlightColorIndex = wdYellow
                    End If
                

                        
                        Selection.Collapse wdCollapseEnd
                    End If
                End If
            End If
        Loop
    End With
End Sub
Function sectionNum(str As String) As String
    Dim reg As New RegExp
    Dim matches
    With reg
        .Global = 1
        .Pattern = "\d(?=\. )"
        Set matches = .Execute(str)
    End With

sectionNum = matches(0)
End Function
Function incrementedOne(str As String) As Boolean

    If CInt(str) > lastCall Then
    
        If CInt(str) - lastCall = 1 Then
            incrementedOne = True
        Else
            incrementedOne = False
        End If
        lastCall = CInt(str)
    Else
        
        incrementedOne = False
    End If
    
End Function