一、软件名称：Word文档自动排版工具
二、软件简介：
本软件主要解决办公人员在处理Word文档时格式不统一、排版效率低下的痛点。
通过智能识别文档结构并应用标准化格式，大幅提升文档排版效率和质量，确保文档格式规范统一。
三、软件功能
本软件是一款专门用于批量自动排版Word文档的工具，主要功能包括：
1. 批量处理：支持拖拽多个Word文档（doc/docx格式）进行批量排版
2. 智能样式识别：自动识别文档中的标题层级和正文内容
3. 自动定义和应用题目、各级标题、正文等标准样式
4. 统一设置字体、字号、颜色、段落间距等格式
5. 表格自动格式化：智能设置表格样式，区分表头和表格内容
6. 图片格式处理：自动调整图片为浮动型并设置合适尺寸和环绕方式
7. 非破坏性操作：排版后另存为新文件，保留原始文件
四、使用方法和操作步骤：
1. 将需要排版的Word文档（一个或多个）直接拖拽到本脚本文件上
2. 程序自动在后台运行，不显示Word界面
3. 处理完成后弹出提示框，在原文件同目录下生成排版后的新文件，文件名格式为"原文件名_formatted.扩展名"
4. 生成排版规范的新Word文档，保持原有文档内容不变，仅调整格式
5. 各层级标题、正文、表格、图片均按标准格式重新排版
五、运行环境
- 系统要求：Windows操作系统，已安装Microsoft Word软件
- 运行方式：直接拖拽Word文件到脚本文件上运行
六、排版规则说明
1. 样式定义：
- 题目：黑体16磅，加粗，居中，前后间距10磅
- 标题1：黑体14磅，加粗，左对齐，前后间距7磅
- 标题2：楷体12磅，加粗，左对齐，前后间距5磅
- 标题3：仿宋11磅，加粗，左对齐，前后间距5磅
- 正文：仿宋12磅，两端对齐，首行缩进2字符
2. 标题识别规则：
- 标题1：识别"一、"、"二、"等格式
- 标题2：识别"（一）"、"（二）"等格式
- 标题3：识别"1."、"2."等数字加点格式
3. 表格格式化：
- 表格整体居中，自动调整列宽
- 表头：黑体12磅，加粗，居中
- 表格内容：仿宋11磅，居中对齐
4. 图片处理：
- 转换为浮动型图片
- 设置四周环绕
- 页面居中显示
- 按比例缩放至合适尺寸
七、特色亮点
- 操作简便：拖拽即可使用，无需复杂配置
- 批量处理：支持同时处理多个文档
- 智能识别：自动判断文档结构和标题层级
- 格式统一：确保所有文档符合统一的排版规范
- 安全可靠：保留原始文件，生成新的排版文件
- 处理全面：涵盖文字、表格、图片等各类元素格式调整
- 代码开源：可以用记事本打开源码，进行自助修改，如自定义格式等。
八、注意事项
本软件运行中不显示界面，需要拖动文件到vbs文件个执行，双击无法执行操作。
注意：本工具适用于一般办公文档排版，对于特殊格式要求的专业文档，建议在自动排版基础上进行手动调整。
九、代码展示
[Visual Basic] 纯文本查看 复制代码 ' =========================================
' AutoFormatDocuments.vbs
' 功能：自动排版 Word 文档（支持拖拽多个 doc/docx 文件），排版后另存为新文件
' =========================================
Option Explicit
Dim args, i
Set args = WScript.Arguments
If args.Count = 0 Then
MsgBox "请将一个或多个 Word 文件拖到本脚本上进行自动排版。", vbInformation, "提示"
WScript.Quit
End If
Dim wordApp
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = False ' 不显示 Word 窗口
For i = 0 To args.Count - 1
AutoFormatDocument args(i)
Next
wordApp.Quit
Set wordApp = Nothing
MsgBox "所有文档排版完成！新文件已生成。", vbInformation, "完成"
' =========================================
' 自动排版主过程
' =========================================
Sub AutoFormatDocument(filePath)
On Error Resume Next
Dim doc, fso, folderPath, baseName, ext, newFilePath
Set fso = CreateObject("Scripting.FileSystemObject")
folderPath = fso.GetParentFolderName(filePath)
baseName = fso.GetBaseName(filePath)
ext = fso.GetExtensionName(filePath)
newFilePath = folderPath & "\" & baseName & "_formatted." & ext
Set doc = wordApp.Documents.Open(filePath)
If doc Is Nothing Then
MsgBox "无法打开文件: " & filePath, vbExclamation, "错误"
Exit Sub
End If
' 1. 清除格式
doc.Content.WholeStory
doc.Content.ClearFormatting
' 2. 定义样式
DefineStyles doc
' 3. 应用样式
ApplyStylesToDocument doc
' 4. 格式化表格
FormatTables doc
'5. 格式化图片
FormatPictures doc
' 6. 另存为新文件
doc.SaveAs2 newFilePath
doc.Close False
End Sub
' =========================================
' 定义样式
' =========================================
Sub DefineStyles(doc)
Dim blackColor
blackColor = RGB(0, 0, 0)
' 自定义“题目”样式
With doc.Styles.Add("题目", 1)
.AutomaticallyUpdate = False
With .Font
.Name = "黑体"
.Size = 16
.Bold = True
.Color = blackColor
End With
With .ParagraphFormat
.Alignment = 1
.SpaceBefore = 10
.SpaceAfter = 10
End With
End With
' 标题 1
With doc.Styles("标题 1").Font
.Name = "黑体"
.Size = 14
.Bold = True
.Color = blackColor
End With
With doc.Styles("标题 1").ParagraphFormat
.SpaceBefore = 7
.SpaceAfter = 7
.Alignment = 0
.OutlineLevel = 1
End With
' 标题 2
With doc.Styles("标题 2").Font
.Name = "楷体"
.Size = 12
.Bold = True
.Color = blackColor
End With
With doc.Styles("标题 2").ParagraphFormat
.SpaceBefore = 5
.SpaceAfter = 5
.Alignment = 0
.OutlineLevel = 2
End With
' 标题 3
With doc.Styles("标题 3").Font
.Name = "仿宋"
.Size = 11
.Bold = True
.Color = blackColor
End With
With doc.Styles("标题 3").ParagraphFormat
.SpaceBefore = 5
.SpaceAfter = 5
.Alignment = 0
.OutlineLevel = 3
End With
' 正文
With doc.Styles("正文").Font
.Name = "仿宋"
.Size = 12
.Bold = False
.Color = blackColor
End With
With doc.Styles("正文").ParagraphFormat
.SpaceBefore = 0
.SpaceAfter = 0
.Alignment = 3
.FirstLineIndent = doc.Application.CentimetersToPoints(0.74)
.LineSpacingRule = 3
End With
End Sub
' =========================================
' 应用样式到段落
' =========================================
Sub ApplyStylesToDocument(doc)
Dim para, text, index
index = 1
For Each para In doc.Paragraphs
text = Trim(para.Range.Text)
If Len(text) > 1 Then
If index = 1 Then
para.Style = "题目"
ElseIf IsHeading1(text) Then
para.Style = "标题 1"
ElseIf IsHeading2(text) Then
para.Style = "标题 2"
ElseIf IsHeading3(text) Then
para.Style = "标题 3"
Else
para.Style = "正文"
End If
End If
index = index + 1
Next
End Sub
' =========================================
' 判断标题级别
' =========================================
Function IsHeading1(text)
If Len(text) >= 2 Then
IsHeading1 = (Mid(text, 2, 1) = "、")
Else
IsHeading1 = False
End If
End Function
Function IsHeading2(text)
If Len(text) >= 3 Then
IsHeading2 = (Left(text, 1) = "（" And Mid(text, 3, 1) = "）")
Else
IsHeading2 = False
End If
End Function
Function IsHeading3(text)
If Len(text) >= 2 And Len(text) <= 16 Then
IsHeading3 = (IsNumeric(Left(text, 1)) And Mid(text, 2, 1) = ".")
Else
IsHeading3 = False
End If
End Function
' =========================================
' 完整表格格式化宏
' =========================================
Sub FormatTables(doc)
Dim tbl, r, c
Dim headerFontSize, bodyFontSize
headerFontSize = 12 ' 表头字号
bodyFontSize = 11 ' 正文字号
For Each tbl In doc.Tables
' 表格整体居中，允许自动调整宽度
tbl.Alignment = 1
tbl.AllowAutoFit = True
tbl.Rows.HeightRule = 1
' 1?设置正文（第2行及以后）
If tbl.Rows.Count > 1 Then
For r = 2 To tbl.Rows.Count
For Each c In tbl.Rows(r).Cells
With c.Range
.Font.Name = "仿宋"
.Font.Size = bodyFontSize
.Font.Bold = False
.ParagraphFormat.Alignment = 1 ' 水平居中
End With
c.VerticalAlignment = 1 ' 垂直居中
Next
Next
End If
' 2 设置表头（第一行）
If tbl.Rows.Count >= 1 Then
tbl.Rows(1).HeadingFormat = True ' 显式标记表头
For Each c In tbl.Rows(1).Cells
With c.Range
.Font.Name = "黑体"
.Font.Size = headerFontSize
.Font.Bold = True
.ParagraphFormat.Alignment = 1 ' 水平居中
End With
c.VerticalAlignment = 1 ' 垂直居中
Next
End If
Next
End Sub
' =========================================
' 将所有行内图片转换为浮动型并居中
' =========================================
Sub ConvertPicturesToFloating(doc)
Dim pic, shp
Dim targetHeight, maxWidth
targetHeight = doc.Application.CentimetersToPoints(6) ' 高度 6cm
maxWidth = doc.Application.CentimetersToPoints(15) ' 最大宽度 15cm
' 遍历所有行内图片
For Each pic In doc.InlineShapes
' 转换为浮动型 Shape
Set shp = pic.ConvertToShape
' 设置自动换行为四周环绕（Square）
shp.WrapFormat.Type = 3 ' wdWrapSquare
' 居中页面
shp.Left = -999995 ' wdShapeCenter
shp.Top = -999995 ' wdShapeTop (可选)
' 按比例缩放
shp.LockAspectRatio = True
shp.Height = targetHeight
If shp.Width > maxWidth Then
shp.Width = maxWidth
End If
Next
End Sub
十、源文件下载
自动排版.zip
(2.38 KB, 下载次数: 1349)
| 
[复制链接]
发表于 2025-11-2 21:20
|
发表于 2025-11-2 20:11
|楼主
分享到朋友圈
