word办公插件中的佼佼者，Word魔方

盛行自动化办公的今天，越来越多的自动化办公插件涌现出来。今天就介绍其中一款插件，Word魔方。

 

魔方包含90多个强大功能。其中包括一键AI智能排版、批量合并文档、批量拆分文档、批量提取Word数据到Excel、批量插入首页封面、批量整理文档格式、批量插入图片、批量另存图片、批量插入图片、批量统一图片尺寸、批量调整Word表格的格、批量生成PDF、批量转换PDF等等。

插件在一些复杂功能中，添加了演示视频，让第一次使用的人也不会摸不着头脑，无从下手。

我们着重介绍其中的一些功能：

• 多文档格式大师

该功能支持批量处理多个文档中的特定内容，包含删除空行、删除页眉页脚、删除可选文字、空白页、最后一段、表格转文字、清除超链接和网址、去白字、去除页眉横线、去除水印、清除所有图片、清除手机号、清除白色背景、清除属性、去除文本框复选框、清除邮箱、手动换行符转回车符等。

支持对文件夹下所有的文档执行操作，支持子文件夹。

 

• 批量添加页眉页脚

批量对多个文档添加页眉或者页脚，支持向页眉页脚中添加自定义文字以及图片，支持添加的同时，对页眉页脚添加限制编辑的密码。

此功能对于保护自己的文档大有作用。

• 批量插入图片到表格【多行信息】 

将多个图片插入到Word的表格中，图片下方备注多行信息，另外可以选择插入后图片展示几列。多行信息来自于图片名字，图片名字要遵循一定命名规则，例如：信息1+信息2+信息3.jpg，导入word表格之后，图片下方展示的信息就是：信息1、信息2、信息3

 

• 按关键字位置取值到Excel【纯段落】

通常我们要重复提取每个文档中一些关键字后面的东西，例如：【联系人：】后面的名字；【联系电话：】后面的具体内容。这个时候我们就可以把这些值得前后关键词限定条件录入，交给插件去批量取抓取数据到Excel。

提取多文档数据到Excel【段落+表格】是 提取多文档数据到Excel【纯表格】的升级版，针对内部是【表格+一般文字性描述段落】混合的文档，例如：一些调查表、技术交底等。可以一键提取所有文档中固定位置和相对位置的数据

• 合并、拆分文档

快速批量合并多个Word文档。需要注意的是，如果多个word文档格式不一致，合并之后，格式不能保证上下文一致。

按页数拆分文档，可以每1页拆分为1个文档，也可以每2页拆分为一个文档，拆分的页数自己来设定。

按一级标题去拆分文档，有多少个一级标题，就拆成多少个文档。

其中，导出关键字所在页功能应用广泛

导出包含某个关键字的页面成为独立文档。并且支持导出的文档转化为pdf文件。常见使用场景：导出签字页、导出XX调查表、导出合同最后几页附件表格等。

在插件的编写过程中，借鉴了很多优秀代码，下面也列举一些：

• word批量插入图片（表格）

Sub t()
    Set wd = Application
    Dim h As Integer
    Dim n As Integer
    Dim M As Integer
    Dim picrow As Integer
    Dim picname As String
    Dim picwidth
    Dim i
    Dim prr
    Dim pagewidth As Double
    wd.ScreenUpdating = False
    Dim a
    Dim P As Word.InlineShape
    Dim t As Word.Table
    If wd.Selection.Information(12) = True Then MsgBox ("请将光标置于表格之外！"): Exit Sub
    pagewidth = wd.ActiveDocument.PageSetup.pagewidth - wd.ActiveDocument.PageSetup.LeftMargin - wd.ActiveDocument.PageSetup.RightMargin
    With wd.FileDialog(3)
        .Title = "请选择..."
        If .Show = -1 Then
            n = Val(InputBox("请输入表格的列数：", "列数", 3))
            picrow = Val(InputBox("请输入图片信息总行数：" & vbCrLf & "例如：" & vbCrLf & vbCrLf & "张三+20220209+天津市" & vbCrLf & "这种就输入3" & vbCrLf & vbCrLf & "张三+天津市" & vbCrLf & "这种就输入2", "行数", 3))
            If Val(n) = 0 Then Exit Sub
            If Val(picrow) = 0 Then Exit Sub
            M = .SelectedItems.Count
            'h = IIf(M / n = Int(M / n), 2 * M / n, 2 * (Int(M / n) + 1))
            '有余数就+1，没有余数不需加1
            h = IIf(M / n = Int(M / n), (picrow + 1) * M / n, (picrow + 1) * (Int(M / n) + 1))
            Set t = wd.ActiveDocument.Tables.Add(wd.Selection.Range, h, n)
            t.Borders.Enable = True
            t.Borders.OutsideLineStyle = 7
            For Each a In .SelectedItems
                picname = GetFileInfo(a, 2)
                prr = Split(picname, "+")
                Set P = wd.Selection.InlineShapes.AddPicture(FileName:=a, SaveWithDocument:=True)
                With P
                    picwidth = .Width
                    .Width = Int(pagewidth / n)
                    .Height = .Width * .Height / picwidth
                End With
                i = i + 1
                '移动光标写入内容，设置内容居中显示
                wd.Selection.MoveLeft 1, 1
                For j = 0 To UBound(prr)
                    wd.Selection.MoveDown 5, 1
                    wd.Selection.TypeText (prr(j))
                    wd.Selection.Cells(1).Select
                    wd.Selection.ParagraphFormat.Alignment = 1 '决定了首行居中
                Next
                '/
                wd.Selection.HomeKey
                wd.Selection.MoveUp 5, UBound(prr) + 1
                wd.Selection.MoveRight 1, 2
                'Debug.Print i, n
 
                '/换行操作替代
                If i = Val(n) Then
                    Dim activetbl As Word.Table
                    Dim activerow As Integer
                    activerow = Selection.Information(wdStartOfRangeRowNumber)
                    Set activetbl = Selection.Tables(1)
                    activetbl.Cell(activerow + picrow + 1, 1).Select
                    'wd.Selection.MoveRight 1, 1
                    'wd.Selection.Cells(1).Select
                    'wd.Selection.EndKey
                    'wd.Selection.MoveDown 5, UBound(prr) + 1
                     i = 0
                End If
            Next
        End If
    End With
    wd.ScreenUpdating = True
    MsgBox "完成！共导入" & M & "张图片。", vbInformation, "Word魔方"
    'Catch
    ' MsgBox(Err.Description)
    ' wd.ScreenUpdating = True
    'End Try
End Sub

 

• 查找隐藏文本

Sub 查找隐藏文本()
    With ActiveDocument.Content.Find    '查找全文
        .ClearFormatting                '清除查找框格式
        .Format = True                  '查找包含格式
        .Font.Hidden = True             '查找字体格式为隐藏的
        .Forward = True                 '向前查找
        .Wrap = wdFindStop              '查找完成后停止
        Do While .Execute               '如果找到了
            '分别打印：找到的内容，找到内容的开始位置，找到内容的结束位置
            Debug.Print .Parent, .Parent.Start, .Parent.End
        Loop
    End With
End Sub

• Word反向查找

Sub 向上查找关键字()
    Selection.HomeKey Unit:=wdLine                             '先到行首,因上次查找后,光标定位在查找结果之后
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "你好"
        .Replacement.Text = ""
        .Forward = False'关键语句
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
End Sub

更多更全的功能介绍如下：