|
楼主 |
发表于 2009-9-19 09:45
|
显示全部楼层
感谢kqbt,带○的年份不可用,根本原因word查找不到○……
Sub ChrDateToAraDate()
Dim ChrDat As String * 10, AraDat As String * 10, MyRange As Range , YearRange As Range , MonthRange As Range , DayRange As Range
ChrDat = "〇一二三四五六七八九"
AraDat = "0123456789"
Selection.HomeKey wdStory '将光标返回之文档开头
With Selection.Find
.ClearFormatting '清楚查找框格式
.Replacement.ClearFormatting '清楚替换内格式容
.MatchWildcards = True '使用通配符
.Text = "[〇一二三四五六七八九]{4}年[一二三四五六七八九十]{1,}月[一二三四五六七八九十]{1,}日"
Do While .Execute
'Do While Selection.Find.Execute = True '当查找到段落居中的文字时
Set MyRange = Selection.Range
Set YearRange = ActiveDocument.Range(MyRange.Start, MyRange.Start + 4)
Set MonthRange = ActiveDocument.Range(YearRange.End + 1, MyRange.Start + (InStr(MyRange, "月") - 1))
Set DayRange = ActiveDocument.Range(MonthRange.End + 1, MyRange.End - 1)
YearRange.Text = Mid(AraDat, InStr(ChrDat, Mid(YearRange, 1, 1)), 1) & _
Mid(AraDat, InStr(ChrDat, Mid(YearRange, 2, 1)), 1) & _
Mid(AraDat, InStr(ChrDat, Mid(YearRange, 3, 1)), 1) & _
Mid(AraDat, InStr(ChrDat, Mid(YearRange, 4, 1)), 1)
If Len(MonthRange) = 1 Then
If MonthRange = "十" Then
MonthRange.Text = "10"
Else
MonthRange.Text = Mid(AraDat, InStr(ChrDat, MonthRange), 1)
End If
ElseIf Len(MonthRange) Then
MonthRange.Text = "1" & Mid(AraDat, InStr(ChrDat, Mid(MonthRange, 2, 1)), 1)
End If
If Len(DayRange) = 1 Then
If DayRange = "十" Then
DayRange.Text = "10"
Else
DayRange.Text = Mid(AraDat, InStr(ChrDat, DayRange), 1)
End If
ElseIf Len(DayRange) = 2 Then
If Mid(DayRange, 1, 1) = "十" Then
DayRange.Text = "1" & Mid(AraDat, InStr(ChrDat, Mid(DayRange, 2, 1)), 1)
Else
DayRange.Text = Mid(AraDat, InStr(ChrDat, Mid(DayRange, 1, 1)), 1) & "0"
End If
Else
DayRange.Text = Mid(AraDat, InStr(ChrDat, Mid(DayRange, 1, 1)), 1) _
& Mid(AraDat, InStr(ChrDat, Mid(DayRange, 3, 1)), 1)
End If
Loop
End With
End Sub
[ 本帖最后由 第Ⅸ夜 于 2009-9-22 10:46 编辑 ] |
|