以下是引用风中侠在2004-10-16 19:21:00的发言：
你电子表格形式的笔画数据库是怎么取得的,有什么好方法吗?
风兄你好！上次你提及的域及其运算事宜等你回国后再作具体探讨可能要有一些规定措施才能让程序进行合理分辩和检测。
笔画数据库的提取，涉及到几个程序：汉字编码反查，"C:\Program Files\Windows NT\Accessories\Imegen.exe"，然后取其常见字约个6763个作为汉字文字，主要是一些生僻字在“汉字笔画计算器“ 中也不能计算出来 ，这样可以减少出错否则一个没有找到以下的就对不上号了。将简体汉字放在EXCEL工作表中。
然后在网上下载了一个汉字笔画计算器，一次性能算一个到一段文字的汉字笔画。
在WORD中编程后台调用EXCEL工作表中的汉字，后台调用汉字笔画计算器程序输入到其中，再粘贴回到WORD中此时除了数据字外全是乱码。
在经过编程与核对确认无误后，将其中的数据写于EXCEL工作表中成为笔画库。
以下的后台调用程序供网友们日后参考：
Sub Hzcx()
Dim Hzexe, CharHz As String, i As Integer, n As Integer, i1 As Integer, i2 As Integer
Dim xlObj As Excel.Application, Wk As Excel.Workbook, C As Excel.Range
On Error Resume Next
Application.ScreenUpdating = False
If Tasks.Exists("Microsoft Excel") = True Then
Set xlObj = GetObject(, "Excel.Application")
Else
Set xlObj = CreateObject("Excel.Application")
End If
Set Wk = xlObj.Workbooks.Open("d:\xlhzbh.xls")'调用汉字简体字工作表
For n = 1 To 136
CharHz = ""
i1 = (n - 1) * 50 + 1
i2 = n * 50
For i = i1 To i2
CharHz = CharHz & Wk.Sheets(1).Cells(i, 2)
Next
With Selection
.InsertAfter CharHz & Chr(13)
.EndKey Unit:=wdStory
Hzexe = Shell("D:\hzbh\hzbh.exe", 1)'调用汉字笔画计算器程序
AppActivate Hzexe
SendKeys CharHz, True'将汉字组发送到当前程序中
SendKeys "{tab 3}", True
SendKeys "^c", True'复制笔画数
SendKeys "%{f4}", True'关闭程序
.EndKey Unit:=wdStory
.Paste'文档末尾粘贴
.InsertAfter Chr(13)
.EndKey Unit:=wdStory
End With
Next
Wk.Close False
Application.ScreenUpdating = True
End Sub
'-------------------------------------------------------------------
Sub TestRep()
Dim i As Paragraph, n As Integer, Ra As Variant, FindRage As Range
Application.ScreenUpdating = False
For Each i In Me.Paragraphs
n = n + 1
Ra = n Mod 2
If Ra = 0 Then
Set FindRage = i.Range
With FindRage.Find
.Text = "[!(0-9)]"
.Replacement.Text = ""
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
FindRage.InsertAfter "分隔号"
End If
Next
Application.ScreenUpdating = True
End Sub
'---------------------------------------------------
Sub WriteEXCEL()
Dim P As Paragraph, i As Range, n As Integer, GetRange As Range, C As Integer
Application.ScreenUpdating = False
If Tasks.Exists("Microsoft Excel") = True Then
Set xlObj = GetObject(, "Excel.Application")
Else
Set xlObj = CreateObject("Excel.Application")
End If
xlObj.Visible = True
Set Wk = xlObj.Workbooks.Open("d:\xlhzbh.xls")
For Each P In Me.Paragraphs
n = n + 1
If n Mod 2 = 0 Then
Set GetRange = P.Range
For Each i In GetRange.Words
If i Like "*#" = True Then
C = C + 1
Wk.Sheets(1).Cells(C, 3) = i * 1
End If
Next i
End If
Next P
Application.ScreenUpdating = True
End Sub
以上程序代码均在WORD中完成. | 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2004-10-16 17:05
![[原创并分享]:汉字笔画知多少?](https://files-c.excelhome.net/forum/dvbbs/2004-10/20041016165735196.bmp "[原创并分享]:汉字笔画知多少?")
楼主
