选定范围数据插入千分位

wjsnb

高手们有没有办法实现选定范围数据插入千分位。（全文数据插入千分位已放在文件中）

wjsnb

Sub FormatNumbers2() '选定千分位
On Error Resume Next
Dim i As Range, Acell As Cell, CR As Range
    On Error Resume Next
    Application.ScreenUpdating = False
    If Selection.Type = 2 Then '文档选定
             For Each i In Selection.Words
            If i Like "####*" = True Then
                If i.Next Like "." = True And i.Next(wdWord, 2) Like "#*" = True Then
                    i.SetRange Start:=i.Start, End:=i.Next(wdWord, 2).End
                    NC = Format(i, "#,##0.00;-#,##0.00; ")
                     i.Text = NC
                         Else
                      NC = Format(i, "#,##0.00;-#,##0.00; ")
                     i.Text = NC

                       End If
          End If
        Next i
    ElseIf Selection.Type = 4 Or Selection.Type = 5 Then '竖形表格（5为横形表格）
        For Each Acell In Selection.Cells
            Set CR = ActiveDocument.Range(Acell.Range.Start, Acell.Range.End - 1)
'            MsgBox CR
            If CR Like "-####*" Or "-####.#*" = True Then
                  Yn = Format(CR, "#,##0.00;-#,##0.00; ")
                    CR.Text = Yn
                      Else
                If CR Like "####*" Or "####.#*" = True Then
               Yn = Format(CR, "#,##0.00;-#,##0.00; ")
                    CR.Text = Yn
              End If
               End If
        Next Acell
    Else
        MsgBox "您只能选定文本或者表格之一!", vbOK + vbInformation
    End If
    Application.ScreenUpdating = True

End Sub