一、缘起

在日常工作中，经常遇到需要大量手写的时候，比如申请书、读后感、观后感，还有单位要求的其他需要手写的文档。作为信息技术人员，当然是能用计算机解决的，就绝不动手。下面就分享自己在打印体转手写体的一次实践。

二、实现

1、下载手写字体

字体网站很多（常用的字体天下），可以去下载免费的手写字体

2、导入书写字体

大多数的系统字体都在这个路径：C:\Windows\Fonts，我们只需要把刚才下载的字体解压，然后放到这个路径就大功告成。

3、效果展示

有点手写的感觉了，但仔细看你会发现许多问题，比如字体都是一样大，并且每行都十分整齐，相邻两个字左右间距一致，然而我们手写的时候是做不到打印体这样整齐的，所以需要继续优化。

4、利用VBA优化

需要实现三点，一、字体大小需要在一定范围内波动；二、行间距需要随机波动；三、左右字间距需要随机波动。代码如下：

Dim R_Character As Range
' 字体大小在下列值之间进行波动，改成需要的大小，重复出现的次数越多，相应出现的概率越大，最小精度0.5
Dim FontSize() As String
FontSize = Split("17.5,18.5,19.5,19,18", ",")
Dim FontName() As String
FontName = Split("陈静的字完整版,萌妹子体,李国夫手写体", ",")
'a数值越大，行距越大，波动范围a+x, x∈[-1~1]
a = 0
'b数值越大，字距越大，波动范围b+x, x∈[-1~1]
b = 0
'行间距 在一定以下值中均等分布，改成需要的大小，范围c+x, x∈[0~5]
c = 25
For Each R_Character In ActiveDocument.Characters
VBA.Randomize
' 数组长度
FontNameLength = UBound(FontName) - LBound(FontName)
FontSizeLength = UBound(FontSize) - LBound(FontSize)
' 字号大小
R_Character.Font.Size = FontSize(Int(VBA.Rnd * FontSizeLength) + 1)
' 字的上下偏移
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

5、优化后效果

三、附件

1、A4纸打印效果

2、信纸打印效果

3、完整代码

Sub 字体修改()
' 字体修改 宏
Dim R_Character As Range
' 字体大小在下列值之间进行波动，改成需要的大小，重复出现的次数越多，相应出现的概率越大，最小精度0.5
Dim FontSize() As String
FontSize = Split("17.5,18.5,19.5,19,18", ",")
'字体名称在下列字体之间进行波动，改成需要的字体，但需要保证系统拥有下列字体，可以在word查看字体名字
Dim FontName() As String
FontName = Split("陈静的字完整版,萌妹子体,李国夫手写体", ",")
' 推荐字体
' "萌妹子体,张维镜手写楷书,萌妹子体,汉仪晨妹子W,小豆岛风物诗简繁,小豆岛秋日和简繁"
'a数值越大，行距越大，波动范围a+x, x∈[-1~1]
a = 0
'b数值越大，字距越大，波动范围b+x, x∈[-1~1]
b = 0
'行间距 在一定以下值中均等分布，改成需要的大小，范围c+x, x∈[0~5]
c = 25
For Each R_Character In ActiveDocument.Characters
VBA.Randomize
' 数组长度
FontNameLength = UBound(FontName) - LBound(FontName)
FontSizeLength = UBound(FontSize) - LBound(FontSize)
' 字号大小
R_Character.Font.Size = FontSize(Int(VBA.Rnd * FontSizeLength) + 1)
' 字的上下偏移
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 R_Character = "。" Or R_Character = "，" Or R_Character = "," Or R_Character = "；" Or R_Character = "’" Or R_Character = "‘" Or R_Character = "“" Or R_Character = "”" Or R_Character = "！" Or R_Character = "？" Or R_Character = "、" Or R_Character = "：" Then
' 中文常用标点符号
' 标点固定用以下字体
R_Character.Font.Name = "李国夫手写体"
' 标点随机用FontName中字体
'R_Character.Font.Name = FontName(Int(VBA.Rnd * FontSizeLength))
ElseIf Asc(R_Character) >= 48 And Asc(R_Character) <= 57 Then
' 数字
R_Character.Font.Name = "陈静的字完整版"
ElseIf Asc(R_Character) >= 97 And Asc(R_Character) <= 122 Or Asc(R_Character) >= 65 And Asc(R_Character) <= 90 Or R_Character = "." Or R_Character = "（" Or R_Character = "）" Or R_Character = "(" Or R_Character = ")" Then
' 大小写字母
R_Character.Font.Name = "陈静的字完整版"
End If
Next
For Each Cur_Paragraph In ActiveDocument.Paragraphs
' 设置行间距类型为固定值
Cur_Paragraph.LineSpacingRule = wdLineSpaceExactly
' 设置行间距的值
Cur_Paragraph.LineSpacing = Int(VBA.Rnd * 5) + 1 + c
Next
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "“"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "”"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Application.ScreenUpdating = True
End Sub

利用VBA实现word文档手写体打印相关推荐

VBA读取html表格内容,科学网—VBA读取word文档表格中table的cell的text文本 - 付安民的博文...
VBA读取word文档表格中table的cell的text文本已有 11546 次阅读 2010-6-4 16:40 |个人分类:学习篇|系统分类:科研笔记 Sub Readtable() Dim ...
wps文件一点打印就关闭打印机服务器,word打印闪退 word文档一打印就闪退
是的打印机设置问题,可能是某个打印机服务没有打开当添加打印机或是使用打印机时,系统报错"打印后台程序服务没有运行",一般会发生在 Windows 2000.XP.2003 系统下, ...
matlab 生成 word 表格,利用MATLAB生成Word文档.doc
利用MATLAB生成Word文档 function ceshi_Word %利用MATLAB生成Word文档 % ceshi_Word % % Copyright 2009 - 2010 xiezhh ...
java利用POI替换word文档中的标签
java利用POI替换word文档中的标签 <dependency><groupId>org.apache.poi</groupId><artifactId& ...
计算机文档不能直接打印,word文档不能打印的处理方法
word文档不能打印的处理方法在使用打印机时,发现没有响应,此时的`你是否十分着急,下面小编教你怎么解决吧. Word打印无反应的解决步骤: 第一步:检查是否安装了打印机; 1.单击"开始 ...
Python3-word文档操作（三）：利用python修改word文档的内容
前两篇博文中,学习了是用python的docx库创建一个word文档,并且编辑了标题和正文,以及利用python来获取word文档的内容.本篇学习利用python修改word文档的内容. 修改word ...
在word文档中打印大号字
在word文档中打印大号字设置之前可以先将页面设置为横向.文件à页面设置à横向一 .使用快捷键操作字体(比较简单实用) 按快捷键 'Ctrl'+'Shift'+'>' 可以将所选择的文字 ...
matlab2015 word,利用MATLAB生成Word文档
<利用MATLAB生成Word文档>由会员分享,可在线阅读,更多相关<利用MATLAB生成Word文档(5页珍藏版)>请在人人文库网上搜索. 1.function ceshi_ ...
利用OpenOffice实现word文档在线预览
项目中遇到的word文档在线预览需求,查阅很多资料决定利用openoffice转换word文档为pdf/html进行预览实现. 1.下载openoffice4安装 www.openoffice.org ...

利用VBA实现word文档手写体打印