|
楼主 |
发表于 2011-3-31 13:41
|
显示全部楼层
Sub 加注千分位()
On Error Resume Next
Dim cc As String
Dim i As Integer, b
cc = ActiveDocument.Content
ss = Len(cc)
i = ss
Do Until i < 1
For i = ss To 0 Step -1 '从后往前找数字
If i < 2 And VBA.IsNumeric(Mid(cc, i, 1)) = False Then Exit Sub
If VBA.IsNumeric(Mid(cc, i, 1)) = True Then '找到末位数位置
Exit For
End If
Next
Do Until ((VBA.IsNumeric(Mid(cc, i - b, 1)) = False And Mid(cc, i - b, 1) <> "."))
b = b + 1 '数字长度
If i = b Then Exit Do
Loop
With ActiveDocument.Content.Find
.ClearFormatting
.Text = Right(Left(cc, i), b)
.MatchWildcards = False
.Replacement.ClearFormatting
.Replacement.Text = Format(Right(Left(cc, i), b), "#,###.00") '将数字格式化
.Execute Replace:=wdReplaceOne
End With
If i = b Then Exit Do
cc = Left(cc, (i - b)) '重新赋值
ss = Len(cc) '重新赋值
b = 0 '重新赋值
i = ss
Loop '开始循环
End Sub
[ 本帖最后由 sqhsqhli 于 2011-4-1 21:21 编辑 ] |
|