Word 手写字体效果（VBA 宏：随机字号/字体/偏移/字距/行距）

⚠️ 注意事项

• 宏会遍历 ActiveDocument 的所有字符并写入格式，执行后难以逐项还原，建议先另存副本。
• FontName 中列出的字体必须已安装，否则会回落为系统默认字体。
• 运行宏前建议关闭“修订”，并确认文档中无敏感内容（宏会批量修改格式）。
• 文档较长时执行会有明显耗时，属于正常现象。

1. 使用方法

1.1 启用开发工具（如未启用）

1. 【文件】→【选项】→【自定义功能区】
2. 勾选【开发工具】→【确定】

1.2 添加宏代码

1. 按 Alt + F11 打开 VBA 编辑器
2. 【插入】→【模块】
3. 粘贴下方宏代码

1.3 运行宏

1. 返回 Word
2. 【开发工具】→【宏】
3. 选择 字体修改 →【运行】

2. 宏代码

Sub 字体修改()
    ' Word 手写字体效果：逐字符随机字体/字号/偏移/字距 + 段落随机行距（精确值）
    ' 建议先另存副本再运行

    ' 字体修改 宏
    Dim R_Character As Range
    ' 字体大小在下列值之间进行波动，改成需要的大小，重复出现的次数越多，相应出现的概率越大，最小精度0.5
    Dim FontSize() As String
    FontSize = Split("20,18.5,18.5,19.5,19,18", ",")
    '字体名称在下列字体之间进行波动，改成需要的字体，但需要保证系统拥有下列字体，可以在word查看字体名字
    Dim FontName() As String
    FontName = Split("陈静的字完整版,萌妹子体,汉仪晨妹子W", ",")
    
    ' 初始化随机数生成器
    VBA.Randomize
    
    ' 数组长度
    Dim FontNameLength As Integer
    Dim FontSizeLength As Integer
    FontNameLength = UBound(FontName) - LBound(FontName) + 1
    FontSizeLength = UBound(FontSize) - LBound(FontSize) + 1
    
    ' 设置字体的上下偏移和左右间距的基础值
    Dim a As Double: a = 0 'a数值越大，行距越大，波动范围a+x, x∈[-1~1]
    Dim b As Double: b = 0 'b数值越大，字距越大，波动范围b+x, x∈[-1~1]
    
    ' 循环每一个字符
    For Each R_Character In ActiveDocument.Characters
        ' 字号大小
        R_Character.Font.Size = FontSize(Int(VBA.Rnd * FontSizeLength) + LBound(FontSize))
        
        ' 字的上下偏移和左右间距
        R_Character.Font.Position = Choose(Int(VBA.Rnd * 5) + 1, -1, -0.5, 0, 0.5, 1) + a
        R_Character.Font.Spacing = Choose(Int(VBA.Rnd * 5) + 1, -1, -0.5, 0, 0.5, 1) + b
        
        ' 分别为数字、字母和中文标点符号设置固定字体
        If Asc(R_Character) >= 48 And Asc(R_Character) <= 57 Then
            ' 数字使用固定字体
            R_Character.Font.Name = "汉仪晨妹子W"
        ElseIf Asc(R_Character) >= 97 And Asc(R_Character) <= 122 Or Asc(R_Character) >= 65 And Asc(R_Character) <= 90 Then
            ' 英文字母使用固定字体
            R_Character.Font.Name = "陈静的字完整版"
        ElseIf InStr("。，,；’‘“”！？、：", R_Character) > 0 Then
            ' 中文标点符号使用固定字体
            R_Character.Font.Name = "汉仪晨妹子W"
        Else
            ' 其他字符使用FontName数组中的字体波动
            R_Character.Font.Name = FontName(Int(VBA.Rnd * FontNameLength) + LBound(FontName))
        End If
    Next R_Character
    
    ' 设置段落的行间距
    Dim c As Integer
    c = 28 '行间距 在一定以下值中均等分布，改成需要的大小，范围c+x, x∈[0~5]
    For Each Cur_Paragraph In ActiveDocument.Paragraphs
        Cur_Paragraph.LineSpacingRule = wdLineSpaceExactly
        Cur_Paragraph.LineSpacing = Int(VBA.Rnd * 5) + c
    Next Cur_Paragraph
    
    Application.ScreenUpdating = True
End Sub

3. 可调参数速查

• FontSize = Split(...)
  • 控制字号的候选集合与概率分布（重复值=更高概率）
• FontName = Split(...)
  • 控制中文/非特殊字符的字体候选集合
• a / b
  • 调整整体“漂浮感”和“松紧度”（建议小步调整，如 0.2、0.5）
• c = 28
  • 行距基础值（最终行距为 c~c+4 的整数随机）

4. 回滚建议

• 优先使用：运行前另存副本 / 版本管理
• 或尝试：Ctrl + Z 撤销（对大文档可能无法完整撤销或撤销栈不足）