kerrypnx
8/13/2018 - 8:02 AM

补全页码-8-13

补全页码-8-13

Sub cpn(ByVal control As IRibbonControl)
Dim unit As String
  Call layout_search_replace.jump_to_reference_section
  With Selection.Find
    .Text = " [0-9]{1,}[-–][0-9]{1,}[!0-9]"
    .MatchWildcards = True
    .Wrap = wdFindStop
    
    .Forward = True
    Do
    .Execute
    unit = Selection.Range.Text
      If Not .Found Then
      Exit Do
        Else
        If InStr(Selection.Range.Text, "-") > 0 Then
        
          arr = Split(Selection.Range.Text, "-")
        
        Else
          arr = Split(Selection.Range.Text, ChrW(8211))
        End If


        If Len(Trim(arr(0))) > Len(Left(arr(1), Len(arr(1)) - 1)) Then
          Selection.Range.Text = FunctionGroup.ComLackPage(Selection.Range.Text)
          Selection.MoveRight wdCharacter, Len(unit)
        End If
        
        
        
      End If
    Loop
  End With
  
End Sub
Function ComLackPage(str As String) As String
   Dim reg As Object
    Set reg = CreateObject("VBScript.Regexp")
    Dim is_exist As Boolean
    With reg
        .Global = True
        .Pattern = " (\d\d+)([-–]\d+)(?!\d)"
        is_exist = .test(str)
    End With
    Dim matches As Object, match As Object
    Set matches = reg.Execute(str)
    
    If is_exist = True Then
      For Each match In matches
      
        firstNum = match.submatches(0)
        NextNum = Right(match.submatches(1), Len(match.submatches(1)) - 1)
        
        
          Select Case Len(firstNum)
          
          Case 2
            If Len(NextNum) = 1 Then
            If CInt(Right(firstNum, Len(firstNum) - 1)) < CInt(NextNum) Then
              oldnum = match
              
              newnum = Replace(match, NextNum, Left(firstNum, 1) + NextNum)
            End If
            End If
          Case 3
          
            Select Case Len(NextNum)
            
            Case 1
            If CInt(Right(firstNum, Len(firstNum) - 2)) < CInt(NextNum) Then
              oldnum = match
              
              newnum = Replace(match, NextNum, Left(firstNum, 2) + NextNum)
            End If
            
            Case 2
            If CInt(Right(firstNum, Len(firstNum) - 1)) < CInt(NextNum) Then
              oldnum = match
              
              newnum = Replace(match, NextNum, Left(firstNum, 1) + NextNum)
            End If
            
            End Select
          
          Case 4
            Select Case Len(NextNum)
            
            Case 1
            If CInt(Right(firstNum, Len(firstNum) - 3)) < CInt(NextNum) Then
              oldnum = match
              
              newnum = Replace(match, NextNum, Left(firstNum, 3) + NextNum)
            End If
            
            Case 2
            If CInt(Right(firstNum, Len(firstNum) - 2)) < CInt(NextNum) Then
              oldnum = match
              
              newnum = Replace(match, NextNum, Left(firstNum, 2) + NextNum)
            End If
            
          
            
            Case 3
            If CInt(Right(firstNum, Len(firstNum) - 1)) < CInt(NextNum) Then
              oldnum = match
              
              newnum = Replace(match, NextNum, Left(firstNum, 1) + NextNum)
            End If
            
            End Select
            
          Case 5
            
            Select Case Len(NextNum)
            
            Case 1
            If CInt(Right(firstNum, Len(firstNum) - 4)) < CInt(NextNum) Then
              oldnum = match
              
              newnum = Replace(match, NextNum, Left(firstNum, 4) + NextNum)
            End If
            
            Case 2
            If CInt(Right(firstNum, Len(firstNum) - 3)) < CInt(NextNum) Then
              oldnum = match
              
              newnum = Replace(match, NextNum, Left(firstNum, 3) + NextNum)
            End If
            
          
            
            Case 3
            If CInt(Right(firstNum, Len(firstNum) - 2)) < CInt(NextNum) Then
              oldnum = match
              
              newnum = Replace(match, NextNum, Left(firstNum, 2) + NextNum)
            End If
            
            Case 4
            If CInt(Right(firstNum, Len(firstNum) - 1)) < CInt(NextNum) Then
              oldnum = match
              
              newnum = Replace(match, NextNum, Left(firstNum, 1) + NextNum)
            End If
            
            End Select
  
          End Select
        
      Next
    End If
    
    ComLackPage = Replace(Replace(str, oldnum, newnum), "-", "–")
End Function