vba根据内容调整word表格_给你的word提速

曾经贴报告附注的时候需要把各种数据粘贴到word中，其中最让我头疼的事情莫过于word中的格式调整、数字的千分符调整（挤着眼睛去打逗号）、还有把数字换算为万元，手工调整的时候就感觉自己是个呆瓜（当然此瓜非彼瓜），于是自己写了两个小工具，这次一起送给大家。放心，不用安装什么工具箱没有套路收费。

1.三个按钮：千分符、数字除万、数字除万添“万”

首先先看3个按钮的效果：

设置方法非常简单，跟着步骤走，2分钟搞定：

第一步、首先在任何word文档中按ALT+F11，呼出VBE编辑器

第二步、找到左侧normal模板，若没有模块，则右键插入模块

第三步、双击模块1，把下面的代码复制粘贴进来

代码如下：

Sub 除万添万()
Dim i As Single
Application.ScreenUpdating = False
If Selection.Type = 2 Then
        If IsNumeric(Selection.Text) Then
        i = Selection.Text
        p = i / 10000
        q = Format(Round(p, 2), "#,##0.00;-#,##0.00; ")
        Selection.Text = q & "万"
        End If
ElseIf Selection.Type = 5 Then
   For Each Acell In Selection.Cells
   Set CR = ActiveDocument.Range(Acell.Range.Start, Acell.Range.End - 1)
   'MsgBox CR
        If IsNumeric(CR.Text) Then
        i = CR.Text
        p = i / 10000
        q = Format(Round(p, 2), "#,##0.00;-#,##0.00; ")
        CR.Text = q & "万"
        End If
    Next
ElseIf Selection.Type = 4 Then
     For Each Acell In Selection.Cells
   Set CR = ActiveDocument.Range(Acell.Range.Start, Acell.Range.End - 1)
   'MsgBox CR
        If IsNumeric(CR.Text) Then
        i = CR.Text
        p = i / 10000
        q = Format(Round(p, 2), "#,##0.00;-#,##0.00; ")
        CR.Text = q & "万"
        End If
    Next
End If
Application.ScreenUpdating = True
End Sub
Sub 除万()
Dim i As Single
Application.ScreenUpdating = False
If Selection.Type = 2 Then
        If IsNumeric(Selection.Text) Then
        i = Selection.Text
        p = i / 10000
        q = Format(Round(p, 2), "#,##0.00;-#,##0.00; ")
        Selection.Text = q
        End If
ElseIf Selection.Type = 5 Then
   For Each Acell In Selection.Cells
   Set CR = ActiveDocument.Range(Acell.Range.Start, Acell.Range.End - 1)
   'MsgBox CR
        If IsNumeric(CR.Text) Then
        i = CR.Text
        p = i / 10000
        q = Format(Round(p, 2), "#,##0.00;-#,##0.00; ")
        CR.Text = q
        End If
    Next
ElseIf Selection.Type = 4 Then
     For Each Acell In Selection.Cells
   Set CR = ActiveDocument.Range(Acell.Range.Start, Acell.Range.End - 1)
   'MsgBox CR
        If IsNumeric(CR.Text) Then
        i = CR.Text
        p = i / 10000
        q = Format(Round(p, 2), "#,##0.00;-#,##0.00; ")
        CR.Text = q
        End If
    Next
End If
Application.ScreenUpdating = True
End Sub
Sub 千分符() '选定千分位
 
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 IsNumeric(i) Then
            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
          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
Application.Activate
 
End Sub

第四步、设置快速访问栏

第五步、修改一下名称以及图标，搞定

至此，这3个按钮已经被添加到了word快速访问栏了，大家可以测试一下~

注意：这个模块内的代码有一定几率会被杀毒软件定期清理（防止宏病毒），如果哪天失效了，照上述步骤复制一遍代码就行了（到第三步即可），按钮已经不用设置了。

---

2.word格式刷

本文的格式刷，关注<茶瓜子的休闲馆>在后台回复“软件”获取下载地址，请用OFFICE的Word打开

按所里的要求，我预置了一些格式做成了一个小窗体，展示如下：

总共只有3个功能，界面如下：

1、表格格式调整，分为单选和多选调整，如果你只需要调一个表，那么把光标点在这个表格的任意位置，点单选调整即可。如果要同时调多个表，那就要选中连续的几个表，点多选调整。 默认是没有勾“窗口和内容自动调整”的两个选项，勾了以后调出来的表可能会比较丑。（表格建议用单选调整，而且这个工具只能大致粗略的调一遍，肯定是要自己再细致调整的。） 2、段落格式调整，也是分为单选和多选，逻辑与上述一致，调单个段落只用点中段落中的任意位置，无需全选。多段调整则要连续全选段落。（段落可以一次性多选调整） 3、小标题的级次调整，无需多说

4、这些格式我已经写死在VBA代码里面了，如果想更改的话，可以打开VBE编辑器，自己去里面翻翻代码，找到格式相关的关键字自己设置一下，代码都没有加密。

使用注意：这个格式刷文档打开以后点“启动”，建议将弹出主窗体移至屏幕的一边，因为点完按钮后会弹出“完成”的提示框，这个框可能被主窗体挡住，造成假死的感觉（即你看不到提示框，因为它被挡住了，但是不关掉完成提示框，你就操作不了文档），如果假死，按一下回车把“完成”提示框关掉即可。

---

想学习更多的办公技巧或0基础入门VBA，可以关注微信公众号<茶瓜子的休闲馆>