Sub ConnectConson2Dipthongs()
'
' ConnectConson2Dipthongs Macro
'
'
'version 2.0


     '
    Application.ScreenUpdating = False
    Dim Rng As range
    With ActiveDocument.range
        With .find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = "[aeiouy誄btdktdkgfvθdszmnhlrwj" & ChrW(602) & ChrW(712) & ChrW(593) & ChrW(720) & ChrW(596) & ChrW(601) & ChrW(604) & ChrW(618) & ChrW(952) & ChrW(650) & ChrW(652) & "]" _
      & ChrW(9700) & _
      "[aeiouy・ & ChrW(604) & ChrW(602) & ChrW(593) & ChrW(596) & ChrW(601) & ChrW(604) & ChrW(618) & ChrW(650) & ChrW(720) & ChrW(652) & "]{1,2}"
            .Forward = True
            .Wrap = wdFindStop
            .Format = False
            .MatchWildcards = True
            .Execute
        End With
        Do While .find.Found
            .Borders.Enable = True
             Set Rng = .Duplicate
    With Rng
      .Collapse wdCollapseStart
      .Text = ChrW(9660)
      With .Font
        .Size = 8
        .Color = 49407
        .Superscript = True
      End With
    End With
  
    Application.ScreenUpdating = True
End Sub