寻找自定义函数“ChineseFont”！

praijna

各位老师：
       以下内容来自于论坛“FENGJUN”老师，帖子链接：http://club.excelhome.net/thread-837971-2-1.html
       代码里使用了一个函数“ChineseFont”，请问哪位老师手里有，能否发出来学习一下？

谢谢您的关注和修改，经测试代码统计结果还是不准确。以下版主的代码最为准确，但有些词组会统计不到：
Sub UniqWordsCount()
'很准确
'直接输出到新文档
    Dim aword As Range
    Dim aString As String, cstring As String
    aString = ChineseFont(ThisDocument.Range.Text, True)
    '净化处理一下
    'Debug.Print aString
    For Each aword In ThisDocument.Words

        If ChineseFont(aword, True) <> "" Then
            '    If aword <> " " And VBA.Asc(aword) <> 13 Then
            If InStr(1, cstring, aword & ":" & Chr(9)) Then
                '如果累积生成的字串cstring中已经存在，则什么也不做，避免重复
            Else
                arr = Split(aString, aword)
                cstring = cstring & aword & ":" & Chr(9) & UBound(arr) & Chr(13)
            End If
        End If
    Next
    Documents.Add
    Selection.InsertBefore cstring
End Sub

praijna

自己来顶一下，希望能得到老师们的帮助！