Office中国论坛/Access中国论坛

标题: 完美的汉字转拼音函数 [打印本页]

作者: liwen 时间: 2007-8-3 16:00
标题: 完美的汉字转拼音函数
这是使用API函数获取汉字拼音的代码，不过按程序设定，系统中必须安装有“微软拼音输入法”，但程序执行时好象并不涉及“微软拼音输入法”，有谁系统中没装“微软拼音输入法”的测试一下将“微软拼音输入法”改为其他拼音输入法试试不知是否能通过，程序可以获得汉字和词组的拼音（词组中的多音字可以区别），且能获得拼音的声调，同时对于繁体字好象也能得到正确的结果。

[attach]25601[/attach]

[ 本帖最后由 liwen 于 2007-8-3 16:14 编辑 ]

作者: sgrshh29 时间: 2007-8-3 16:45
谢谢分享,另外能不能做成这样的?
[attach]25602[/attach][attach]25603[/attach][attach]25604[/attach]

作者: jicheng 时间: 2007-8-3 16:48
２楼的是不是有这个呀

[ 本帖最后由 jicheng 于 2007-8-3 16:49 编辑 ]

作者: liwen 时间: 2007-8-3 16:57
2楼的好东西，怎么以前就见不到呢？

据我据计，2楼的要求应该通过改写一定的代码来判断或许可以实现。
顺便问一下，带声调的注音符号字符表中有吗？

作者: sgrshh29 时间: 2007-8-4 07:10

原帖由 liwen 于 2007-8-3 16:57 发表
2楼的好东西，怎么以前就见不到呢？

据我据计，2楼的要求应该通过改写一定的代码来判断或许可以实现。
顺便问一下，带声调的注音符号字符表中有吗？

ā, á, ǎ, à, ē, é, ě, è, ī, í, ǐ, ì, ō, ó, ǒ, ò, ū, ú, ǔ, ù, ǖ, ǘ, ǚ, ǜ, ü,

作者: liwen 时间: 2007-8-4 13:04
加上以下代码好似可以达到2楼的第一个要求，

代码只做了简单测试，可能也会有不符合汉语拼音规则的地方，代码做的也比较烂，还是希望sgrshh29 能奉献一个2楼那个源码。

Public Function ZH(str As String)
Dim aa() As String
Dim a As String
Dim o As String
Dim e As String
Dim i As String
Dim u As String
Dim v As String
Dim k, kk As Integer
Dim T, j As Integer

a = "āáǎà"
o = "ōóǒò"
e = "ēéěè"
i = "īíǐì"
u = "ūúǔù"
v = "ǖǘǚǜ"
aa() = Split(PinyinConvers(str), " ")
For T = 0 To UBound(aa())
zhstr = aa(T)
k = 0
kk = 0
For j = 1 To Len(zhstr)
If InStr("aoeiuv", Mid(zhstr, j, 1)) > 0 Then
k = k + 1
If k > 1 Then
If Mid(zhstr, kk, 1) = "u" Then
ntstr = Left(zhstr, j - 1) & IIf(Mid(zhstr, j, 1) = "a", Mid(a, Right(zhstr, 1), 1), IIf(Mid(zhstr, j, 1) = "o", Mid(o, Right(zhstr, 1), 1), IIf(Mid(zhstr, j, 1) = "e", Mid(e, Right(zhstr, 1), 1), IIf(Mid(zhstr, j, 1) = "e", Mid(e, Right(zhstr, 1), 1), IIf(Mid(zhstr, j, 1) = "i", Mid(i, Right(zhstr, 1), 1), IIf(Mid(zhstr, j, 1) = "u", Mid(u, Right(zhstr, 1), 1), Mid(v, Right(zhstr, 1), 1))))))) & Mid(zhstr, j + 1, Len(zhstr) - j - 1)
End If
Else
ntstr = Left(zhstr, j - 1) & IIf(Mid(zhstr, j, 1) = "a", Mid(a, Right(zhstr, 1), 1), IIf(Mid(zhstr, j, 1) = "o", Mid(o, Right(zhstr, 1), 1), IIf(Mid(zhstr, j, 1) = "e", Mid(e, Right(zhstr, 1), 1), IIf(Mid(zhstr, j, 1) = "e", Mid(e, Right(zhstr, 1), 1), IIf(Mid(zhstr, j, 1) = "i", Mid(i, Right(zhstr, 1), 1), IIf(Mid(zhstr, j, 1) = "u", Mid(u, Right(zhstr, 1), 1), Mid(v, Right(zhstr, 1), 1))))))) & Mid(zhstr, j + 1, Len(zhstr) - j - 1)
kk = j
End If
End If
Next j
If zhstr <> "" Then nstr = nstr & " " & ntstr

Next
ZH = nstr

End Function

作者: liwen 时间: 2007-8-4 13:45
稍微减少一点代码：
Public Function ZHB(str As String)
Dim aa() As String
Dim a As String
Dim k, kk As Integer
Dim T, j As Integer

a = "āáǎàōóǒòēéěèīíǐìūúǔùǖǘǚǜ"
aa() = Split(PinyinConvers(str), " ")
For T = 0 To UBound(aa())
zhstr = aa(T)
k = 0
kk = 0
For j = 1 To Len(zhstr)
If InStr("aoeiuv", Mid(zhstr, j, 1)) > 0 Then
k = k + 1
If k > 1 Then
If Mid(zhstr, kk, 1) = "u" Then
ntstr = Left(zhstr, j - 1) & Mid(a, (InStr("aoeiuv", Mid(zhstr, j, 1)) - 1) * 4 + Right(zhstr, 1), 1) & Mid(zhstr, j + 1, Len(zhstr) - j - 1)
End If
Else
ntstr = Left(zhstr, j - 1) & Mid(a, (InStr("aoeiuv", Mid(zhstr, j, 1)) - 1) * 4 + Right(zhstr, 1), 1) & Mid(zhstr, j + 1, Len(zhstr) - j - 1)
kk = j
End If
End If
Next j
If zhstr <> "" Then nstr = nstr & " " & ntstr

Next
ZHB = nstr

End Function

作者: sgrshh29 时间: 2007-8-4 17:03

原帖由 liwen 于 2007-8-4 13:45 发表
稍微减少一点代码：
Public Function ZHB(str As String)
Dim aa() As String
Dim a As String
Dim k, kk As Integer
Dim T, j As Integer

a = "āáǎàōóǒòēéěèīíǐìūúǔùǖǘǚǜ"
a ...

好贴,顶一把.非常抱歉,因为源代码(其实这个源代码也有一部分是借鉴了其它的代码)已经找不到了,只有一个用源代码转换过来的dll文件.打开数据库后,如果有引用错误,只要在vba的工具引用中重新引用一下这个dll(有时要多引用几次才引用成功).还请liwen见谅.下面就是这个比较完善的汉字转拼音的示例,只记得代码不是很多,大概是你的代码的一半不到一点.[attach]25626[/attach]

作者: goto2008 时间: 2007-8-5 11:32
嘿嘿，学习下。。。。。。。。。

作者: ok003 时间: 2007-8-19 09:26
真不错。
另外问一下：源代码转为dll 怎么转呢？

作者: duomu 时间: 2007-8-19 15:58

原帖由 sgrshh29 于 2007-8-4 17:03 发表

好贴,顶一把.非常抱歉,因为源代码(其实这个源代码也有一部分是借鉴了其它的代码)已经找不到了,只有一个用源代码转换过来的dll文件.打开数据库后,如果有引用错误,只要在vba的工具引用中重新引用一下这个dll( ...

谢谢楼主的贴子

作者: rcylbx 时间: 2007-9-2 08:25
嘿嘿，学习下。。。。。。。。。

作者: zxp0812 时间: 2007-9-26 19:27
老是没钱，烦死了

作者: zxp0812 时间: 2007-9-26 19:51
下不了。

作者: zxp0812 时间: 2007-9-26 19:52
灌水是被逼的

作者: dqsytmh 时间: 2007-12-2 18:22
这么深的理论怎么理解得了呀

作者: djch 时间: 2008-6-19 20:10
学习了！

作者: leo815 时间: 2009-2-3 09:25
谢谢 ,学习了

作者: yisen 时间: 2009-5-14 12:09
下载8楼的文档,打开转换时提示""运行错误,ACTIVEX部位不能创建对象""
是什么问题

还有如何引用DLL文件

作者: wfx_291 时间: 2009-5-27 12:59
学习

作者: 626565 时间: 2009-5-29 11:03
完美的汉字转拼音函数

作者: 学海一舟 时间: 2009-6-12 22:00
不会用

作者: 学海一舟 时间: 2009-6-12 22:01
对，灌水是本版要求的

作者: 13555609005 时间: 2009-6-13 11:16
真不错

作者: ljwolf 时间: 2009-10-7 14:53
太感谢了

作者: sagemeyou 时间: 2009-11-8 11:52

作者: sagemeyou 时间: 2009-11-8 11:53
26#楼是我升到中级会员的最后一贴哈哈

作者: mrd_wxqs 时间: 2010-5-27 21:05
注册了dll文件后还是出错，是怎么回事？

作者: mrd_wxqs 时间: 2010-5-27 21:06
注册了dll文件后还是出错，是怎么回事？

作者: lxing20 时间: 2011-5-9 23:02
更新了吗

作者: lxing20 时间: 2011-5-9 23:03
下的人不多？为什么？

作者: excessstone 时间: 2011-8-31 17:17
口令是什么？

作者: MEPHISTOWALTZ 时间: 2012-4-17 11:37
学习下

作者: MEPHISTOWALTZ 时间: 2012-4-17 13:21
前来学习

作者: yedaoan 时间: 2013-10-9 00:31
虽然，时间已经过去很多年了，你这个例子，在没有安装微软拼音输入法的情况，不能实出首字输出（测试环境 windows8+access2010）

作者: 程研 时间: 2013-10-11 12:42
解包密码？

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)