Oscar Sun

                  Sub 部首214所收常用字_列出()
Dim f As Document, bs As String  'Alt+s
Dim c  As Cell ', r As Byte
Dim b As String, flg As Boolean
If Selection.Range.Characters.Count > 1 Then Exit Sub
b = Selection.Text
'If f Is Nothing Then
    Set f = GetObject(system.SearchPath & "\macros\XXX214部首所收常用字201909.docx")
'    For Each c In f.Tables(1).Columns(2).Cells
'        bs = bs & VBA.Replace(VBA.Replace(VBA.Replace(c.Range.Text, Chr(13) & Chr(7), ""), "【", ""), "】", "")
'    Next c
'    With f.ActiveWindow
'        .WindowState = wdWindowStateMinimize
'        .Visible = True
'    End With

'End If
'r = InStr(bs, b)
For Each c In f.Tables(1).Columns(2).Cells
    If VBA.InStr(c.Range.Text, b) Then
        Exit For
        flg = True
    End If
Next c
If Not flg Then
    MsgBox "沒有此部首!", vbExclamation
Else
    If Selection.Type <> wdSelectionIP Then
        Selection.Collapse wdCollapseEnd
    Else
        Selection.MoveRight
    End If
    Selection.Range.InsertAfter VBA.Replace(c.Range.Text, Chr(13) & Chr(7), "")
End If
f.Close wdDoNotSaveChanges
Set f = Nothing
End Sub