黄金m249打神秘营地:[原创]
来源:百度文库 编辑:九乡新闻网 时间:2024/04/30 00:22:44
Public Sub TranslateAll()
'++++++++++++++++++++++++++++++++++++++++++++++++
'+++ Code By icy/忽又一天 +++
'+++ Email: wzw.icy@gmail.com +++
'+++ Q Q: 365052003 +++
'+++ Blog: Http://hi.baidu.com/suddenday/ +++
'++++++++++++++++++++++++++++++++++++++++++++++++
On Error Resume Next
Dim i As Integer, j As Integer
For i = 0 To 200
For j = 0 To 20
ReplaceCellTxt i, j
Next
Next
End Sub
Private Sub ReplaceCellTxt(ByVal RowIndex As Double, ByVal ColIndex As Double)
'替换指定单元格中的中文字符
On Error Resume Next
Dim i As Integer
Dim PreText As String, CnText As Variant
PreText = Cells(RowIndex, ColIndex)
Debug.Print PreText
If GetChn(PreText) <> "" Then
CnText = Split(GetChn(PreText), ",")
End If
For i = 0 To UBound(CnText)
CurText = TranslateWord(CnText(i))
Debug.Print CurText
If (Not CurText = "NotFound") And (Not Trim(CurText) = "") Then
PreText = Replace(PreText, CnText(i), CurText)
Cells(RowIndex, ColIndex) = PreText
End If
Next
End Sub
Private Function TranslateWord(ByVal StrWord As String) '查找指定字符串在词典中的解释
On Error Resume Next
Dim StrTemp As String
Dim StrWords As Variant
Open "D:\Dic.txt" For Input As #1
TranslateWord = "NotFound"
Do While Not EOF(1)
Line Input #1, StrTemp
Debug.Print StrTemp
StrWords = Split(StrTemp, vbTab)
If Trim(StrWords(0)) = Trim(StrWord) And UBound(StrWords) > 0 Then
TranslateWord = StrWords(1)
Exit Do
End If
Loop
Close #1
End Function
Private Function GetChn(ByVal Str As String) As String '截取字符串中的中文
Dim i As Integer, j As Integer
Dim ChnStr As String
Dim IsPreCn As Boolean
IsPreCn = False
For i = 1 To Len(Str)
If Asc(Mid(Str, i, 1)) < 0 Then
If IsPreCn Then
ChnStr = ChnStr & Mid(Str, i, 1)
Else
ChnStr = ChnStr & "," & Mid(Str, i, 1)
End If
IsPreCn = True
Else
IsPreCn = fasle
End If
Next
If Mid(ChnStr, 1, 1) = "," Then
ChnStr = Mid(ChnStr, 2, Len(ChnStr))
End If
GetChn = ChnStr
Debug.Print GetChn
End Function
'++++++++++++++++++++++++++++++++++++++++++++++++
'+++ Code By icy/忽又一天 +++
'+++ Email: wzw.icy@gmail.com +++
'+++ Q Q: 365052003 +++
'+++ Blog: Http://hi.baidu.com/suddenday/ +++
'++++++++++++++++++++++++++++++++++++++++++++++++
On Error Resume Next
Dim i As Integer, j As Integer
For i = 0 To 200
For j = 0 To 20
ReplaceCellTxt i, j
Next
Next
End Sub
Private Sub ReplaceCellTxt(ByVal RowIndex As Double, ByVal ColIndex As Double)
'替换指定单元格中的中文字符
On Error Resume Next
Dim i As Integer
Dim PreText As String, CnText As Variant
PreText = Cells(RowIndex, ColIndex)
Debug.Print PreText
If GetChn(PreText) <> "" Then
CnText = Split(GetChn(PreText), ",")
End If
For i = 0 To UBound(CnText)
CurText = TranslateWord(CnText(i))
Debug.Print CurText
If (Not CurText = "NotFound") And (Not Trim(CurText) = "") Then
PreText = Replace(PreText, CnText(i), CurText)
Cells(RowIndex, ColIndex) = PreText
End If
Next
End Sub
Private Function TranslateWord(ByVal StrWord As String) '查找指定字符串在词典中的解释
On Error Resume Next
Dim StrTemp As String
Dim StrWords As Variant
Open "D:\Dic.txt" For Input As #1
TranslateWord = "NotFound"
Do While Not EOF(1)
Line Input #1, StrTemp
Debug.Print StrTemp
StrWords = Split(StrTemp, vbTab)
If Trim(StrWords(0)) = Trim(StrWord) And UBound(StrWords) > 0 Then
TranslateWord = StrWords(1)
Exit Do
End If
Loop
Close #1
End Function
Private Function GetChn(ByVal Str As String) As String '截取字符串中的中文
Dim i As Integer, j As Integer
Dim ChnStr As String
Dim IsPreCn As Boolean
IsPreCn = False
For i = 1 To Len(Str)
If Asc(Mid(Str, i, 1)) < 0 Then
If IsPreCn Then
ChnStr = ChnStr & Mid(Str, i, 1)
Else
ChnStr = ChnStr & "," & Mid(Str, i, 1)
End If
IsPreCn = True
Else
IsPreCn = fasle
End If
Next
If Mid(ChnStr, 1, 1) = "," Then
ChnStr = Mid(ChnStr, 2, Len(ChnStr))
End If
GetChn = ChnStr
Debug.Print GetChn
End Function