Oscar Sun

                  Sub 選取區文字之構詞組詞列出() 'Alt+c
Dim chars As String, vocabularyWord As String, i As Byte, L As Byte, dbf As String, vocabulary As String, j As Byte 'https://www.hopenglish.com/hope-tips-should-we-say-vocabularyWord-or-vocabularies
Dim rng As Range, s As Long, e As Long
Dim cnt As New ADODB.Connection, rst As New ADODB.Recordset
Dim IsColor As Boolean
If MsgBox("是否要將個個字標上不同顏色，以便識別？", vbOKCancel) = vbOK Then IsColor = True
chars = Selection.Text
s = Selection.Start
dbf = system.SearchPath & "\Macros\《重編國語辭典修訂本》資料庫.mdb"
cnt.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbf
'《國語辭典》與黃老師編遠東詞典收詞集合：
rst.Open "select 詞 from 詞 order by len(詞),常用等級 desc,詞", cnt ', adOpenKeyset, adLockOptimistic
Do Until rst.EOF
    vocabularyWord = rst.Fields("詞").Value
    L = Len(vocabularyWord)
    For i = 1 To L
        If InStr(chars, Mid(vocabularyWord, i, 1)) = 0 Then
            Exit For
        Else
            j = j + 1
        End If
    Next i
    If j = L Then vocabulary = vocabulary & vocabularyWord & "、"
    j = 0
    rst.MoveNext
Loop
vocabulary = Mid(vocabulary, 1, Len(vocabulary) - 1)
Selection.InsertParagraphAfter
Selection.Collapse wdCollapseEnd
Selection.Font.Color = 12611584
Selection.InsertAfter vocabulary & Chr(13)
If IsColor Then
    Randomize 'https://docs.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/randomize-statement?f1url=https%3A%2F%2Fmsdn.microsoft.com%2Fquery%2Fdev11.query%3FappId%3DDev11IDEF1%26l%3Dzh-TW%26k%3Dk(vblr6.chm1008998)%3Bk(TargetFrameworkMoniker-Office.Version%3Dv16)%26rd%3Dtrue
    Set rng = Selection.Range
    rng.SetRange s, rng.End
    For e = 1 To Len(chars)
        With rng.Find
            .Replacement.Font.Color = RGB(Int((255 * Rnd) + 1), Int((255 * Rnd) + 1), Int((255 * Rnd) + 1))
            .Execute Mid(chars, e, 1), , , , , , , , , Mid(chars, e, 1), wdReplaceAll
        End With
    Next e
End If
rst.Close: cnt.Close
End Sub