【Word】用VBA自动调整Word格式

近期实习过程中需要搜集WORD版本的法律法规，但有的法律法规在官网下载下来是PDF版本的，在转换为WORD并调整格式的过程中存在很多重复性的步骤，实际上可以用VBA大大简化这个过程。一起学起来，打工人！

问题描述

1

将PDF的法律法规用“PDFdo”转换为Word后段落是分块的，在进行法规汇编的时候不便于下一步编辑。

将转换后的Word以纯文本粘贴到新文档的时候存大量的格式问题，如下图所示。

用工具转换为WORD

粘贴为纯文本后的格式

解决步骤

2

① 点击【开发工具】-【Visual Basic】，调出代码窗口

② 将以下代码复制到窗口

（向上滑动查看完整代码）

Sub pdf转换Word格式调整()

Application.DisplayAlerts = False

'

' pdf转换Word格式调整 宏

'

'

    Selection.WholeStory

    Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

    With Selection.Find

        .Text = '— **—'

        .Replacement.Text = ''

        .Forward = True

        .Wrap = wdFindAsk

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchByte = False

        .MatchAllWordForms = False

        .MatchSoundsLike = False

        .MatchWildcards = True

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

    With Selection.Find

        .Text = '^p^p'

        .Replacement.Text = '^p'

        .Forward = True

        .Wrap = wdFindAsk

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchByte = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    With Selection.Find

        .Text = '^p  ^p  ^p  '

        .Replacement.Text = ''

        .Forward = True

        .Wrap = wdFindAsk

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchByte = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

    With Selection.Find

        .Text = '^p  ^p  ^p  '

        .Replacement.Text = ''

        .Forward = True

        .Wrap = wdFindAsk

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchByte = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    With Selection.Find

        .Text = '^p^p'

        .Replacement.Text = ''

        .Forward = True

        .Wrap = wdFindAsk

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchByte = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    Selection.WholeStory

    Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

    With Selection.Find

        .Text = '^p'

        .Replacement.Text = ''

        .Forward = True

        .Wrap = wdFindAsk

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchByte = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    With Selection.Find

        .Text = '：（'

        .Replacement.Text = '：^p（'

        .Forward = True

        .Wrap = wdFindAsk

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchByte = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    With Selection.Find

        .Text = '。（'

        .Replacement.Text = '。^p（'

        .Forward = True

        .Wrap = wdFindAsk

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchByte = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    With Selection.Find

        .Text = '；（'

        .Replacement.Text = '；^p（'

        .Forward = True

        .Wrap = wdFindAsk

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchByte = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    With Selection.Find

        .Text = '。第'

        .Replacement.Text = '。^p第'

        .Forward = True

        .Wrap = wdFindAsk

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchByte = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    With Selection.Find

        .Text = '条'

        .Replacement.Text = '条  '

        .Forward = True

        .Wrap = wdFindAsk

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchByte = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    With Selection.Find

        .Text = ' '

        .Replacement.Text = ''

        .Forward = True

        .Wrap = wdFindAsk

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchByte = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Application.DisplayAlerts = True

End Sub

③ 实际运用中调用

1）将转换后的Word复制到新文档，粘贴时只保留文本；

2）点击【开发工具】-【宏】；

3）选择刚才的代码文件名，点击运行；

4）浏览全文，调整细节，因为每个PDF原来的格式不一样，存在需要手动调整的细节。

PS：

感谢畅总指点。另外由于我用的录制宏功能，代码可能比较冗余，不够优美，欢迎大佬批评指正~

本来想配首歌，一搜索发现棱镜的《等你降落》居然下架了！o(╥﹏╥)o