打印手写字体:修订间差异

来自三线的随记
无编辑摘要
无编辑摘要
第224行: 第224行:


== '''附录''' ==
== '''附录''' ==
[[分类:Other]]
 
Sub 字体修改() ' ' 字体修改 宏 '    Dim R_Character As Range    Dim FontSize(5)    ' 字体大小在5个值之间进行波动,可以改写    FontSize(1) = "21"    FontSize(2) = "21.5"    FontSize(3) = "22"    FontSize(4) = "22.5"    FontSize(5) = "23"    Dim FontName(3)    '字体名称在三种字体之间进行波动,可改写,但需要保证系统拥有下列字体    FontName(1) = "陈静的字完整版"    FontName(2) = "萌妹子体"    FontName(3) = "李国夫手写体"    Dim ParagraphSpace(5)    '行间距 在一定以下值中均等分布,可改写    ParagraphSpace(1) = "12"    ParagraphSpace(2) = "13"    ParagraphSpace(3) = "20"    ParagraphSpace(4) = "7"    ParagraphSpace(5) = "12"    '不懂原理的话,不建议修改下列代码    For Each R_Character In ActiveDocument.Characters        VBA.Randomize        R_Character.Font.Name = FontName(Int(VBA.Rnd * 3) + 1)        R_Character.Font.Size = FontSize(Int(VBA.Rnd * 5) + 1)        R_Character.Font.Position = Int(VBA.Rnd * 3) + 1        R_Character.Font.Spacing = 0    Next    Application.ScreenUpdating = True    For Each Cur_Paragraph In ActiveDocument.Paragraphs        Cur_Paragraph.LineSpacing = ParagraphSpace(Int(VBA.Rnd * 5) + 1)    Next        Application.ScreenUpdating = True End Sub<code>Sub 字体修改()
<code>
Sub 字体修改()
'
'
' 字体修改 宏
' 字体修改 宏
'
'
Dim R_Character As Range
    Dim R_Character As Range
Dim FontSize(5)
 
' 字体大小在5个值之间进行波动,可以改写
 
FontSize(1) = "21"
    Dim FontSize(5)
FontSize(2) = "21.5"
    ' 字体大小在5个值之间进行波动,可以改写
FontSize(3) = "22"
    FontSize(1) = "21"
FontSize(4) = "22.5"
    FontSize(2) = "21.5"
FontSize(5) = "23"
    FontSize(3) = "22"
Dim FontName(3)
    FontSize(4) = "22.5"
'字体名称在三种字体之间进行波动,可改写,但需要保证系统拥有下列字体
    FontSize(5) = "23"
FontName(1) = "陈静的字完整版"
 
FontName(2) = "萌妹子体"
 
FontName(3) = "李国夫手写体"
 
Dim ParagraphSpace(5)
    Dim FontName(3)
'行间距 在一定以下值中均等分布,可改写
    '字体名称在三种字体之间进行波动,可改写,但需要保证系统拥有下列字体
ParagraphSpace(1) = "12"
    FontName(1) = "陈静的字完整版"
ParagraphSpace(2) = "13"
    FontName(2) = "萌妹子体"
ParagraphSpace(3) = "20"
    FontName(3) = "李国夫手写体"
ParagraphSpace(4) = "7"
 
ParagraphSpace(5) = "12"
    Dim ParagraphSpace(5)
'不懂原理的话,不建议修改下列代码
    '行间距 在一定以下值中均等分布,可改写
For Each R_Character In ActiveDocument.Characters
    ParagraphSpace(1) = "12"
VBA.Randomize
    ParagraphSpace(2) = "13"
R_Character.Font.Name = FontName(Int(VBA.Rnd * 3) + 1)
    ParagraphSpace(3) = "20"
R_Character.Font.Size = FontSize(Int(VBA.Rnd * 5) + 1)
    ParagraphSpace(4) = "7"
R_Character.Font.Position = Int(VBA.Rnd * 3) + 1
    ParagraphSpace(5) = "12"
R_Character.Font.Spacing = 0
 
Next
    '不懂原理的话,不建议修改下列代码
Application.ScreenUpdating = True
 
For Each Cur_Paragraph In ActiveDocument.Paragraphs
    For Each R_Character In ActiveDocument.Characters
Cur_Paragraph.LineSpacing = ParagraphSpace(Int(VBA.Rnd * 5) + 1)
 
Next
        VBA.Randomize
Application.ScreenUpdating = True
 
End Sub</code>
        R_Character.Font.Name = FontName(Int(VBA.Rnd * 3) + 1)
 
        R_Character.Font.Size = FontSize(Int(VBA.Rnd * 5) + 1)
 
        R_Character.Font.Position = Int(VBA.Rnd * 3) + 1
 
        R_Character.Font.Spacing = 0
 
 
    Next
 
    Application.ScreenUpdating = True
 
 
 
    For Each Cur_Paragraph In ActiveDocument.Paragraphs
 
        Cur_Paragraph.LineSpacing = ParagraphSpace(Int(VBA.Rnd * 5) + 1)
 
 
    Next
        Application.ScreenUpdating = True
 
 
End Sub
</code>
[[分类:Other]]

2018年1月24日 (三) 12:32的版本

如何让打印出来的字体看起来像手写的?

正经事

嗯,关于二叔的事,就先到此为止了。

我们来说一件正经事,上次的推送发出去之后,反响热烈,

有人催我快快发新推送。

也有人向我提出生活中的困难,希望我能帮忙解决。

舒哥表示,这个忙,帮定了。

为什么我那么有把握呢?

因为舒哥有一位非常擅长抄写文稿的室友,

先秀一波这位同学的毛概笔记。

那个时候是毛概期末考试,

老师规定,考试开卷,

但只允许携带抄写的笔记,

不允许携带打印的笔记。

会生活的我向学长借了一份,

某些同学大概用了四五天去抄笔记,

但我的这位室友,只用了一个下午加一个晚上的时间,就完成了所有的抄写工作。

厚度大概是这样。

虽然字迹不那么好看,

但是胜在没有错别字。

作为一个乐于助人的舒哥,

我自然是要为我的粉丝出头的,

于是乎,我就找到了我的那位室友,

希望他可以伸出援手。

经过一番谈判,

他表示愿意帮助我,

代价是一根巧乐兹。

然后,我们之间就有了这样一段对话:

"你知不知道?"

他顿了一下,脸上露出狡黠的笑容。

"我的笔记是打印的。"

"借别人的稿子复印的?"

我突然觉得我找错人了。

"不是的,我直接将老师给的txt文件,

直接打印成这个样子。"

The Details

作为一个会生活的舒哥,这样的技巧是一定要收入囊中的。

我室友最终答应了我可以将这个操作发到微信公众号上,

但相应的一根巧乐兹的报酬要换成一个烤猪蹄。

下面是这个技巧的细节以及解决问题的思路。

为了使整个过程更加具有条理更有借鉴意义,

我会将这个操作技巧的过程写下了。

第一步,一个粗浅的尝试

想要打印手写字体,

遇到的第一个问题是,

平时我们看到的打印字体,

如宋体,楷体,都太规整了。

这个问题好解决,

我们可以用网上找到的手写字体去进行打印。

百度搜索”字体下载”,我们可以发现很多可以下载字体的网站。

选择合适的字体进行下载,比如,我的同学他就下载了以下的字体。

我的室友他对自己的长相不是很有自信,

为了表现得字如其人,

他特地选了丑一些的字体。

同时也是为了不引人注意,

这世上多数人的字都是丑的,

你想要不被注意,

只需要丑成平均值就可以了。

将电子稿设置为自己下载的字体后,效果大概如下:

进一步提高

似乎可以看,好像有一点手写体的样子了。

是的,如果你不是一个精益求精的人,

这件事确实已经结束了,调整好行间距以后,

就可以打印了。

但有句话说的好,

“对敌人的仁慈,就是对自己的残忍。”

目前我们的稿子,还有很大的缺点。

它太整齐了。

列夫 托尔舒泰曾经说过:”漂亮的字总是相似的,而丑的字各有各的丑法。”

仔细看一下我们的字体,首先是同一个字,是几乎完全一样的。

上文中多次出现的”党”,每次出现的地方样子完全一样,大小一样,形状一样,

这在平时是几乎不可能出现的。

其次,同一行文字过于下边缘过于平滑。

这个感觉怎么说呢?

就跟女生的刘海一样齐。

两者的一个共同点是,有疏有密,但下边缘却落在同一条直线上。

其实小编我高中一直都对女生的刘海感到12分的好奇,
个人认为像上面那张图片,当脸倾斜过来的时候,
头发应该保持竖直向下才是,
但正如上面这张图所示,
女生的刘海总是与面部保持相对静止。

真是让人匪夷所思,感叹造物主的伟大。

好的,废话不多说,我们接着解决问题。

作为一个糙汉子,

我的室友是不会允许他在考试时翻开的笔记本有着如刘海一样公正的字迹。

所以,我们要上每个字大小,上下高度,行间距,在一定范围内浮动。

每个字的字体,在一些字体中进行随机切换,前提是这些字体本身要比较接近。

说了那么多,你可能要骂我,

有闲工夫一个字一个字地修改字体,大小,上下高度,

还不如手动抄一遍呢。

这个问题自然是可以解决的,

因为word有一套内置的编程语言,

是可以对整篇文章进行编程的。

为了使用这一功能,

你需要在Word中,依次点击”文件”->”选项”->”信任中心”->”信任中心设置”->”宏设置”,

然后在跳出的界面中选择”启用所有宏设置”即可。

然后在,依次点击”视图”->”宏”,

输入名字,”字体修改”,在跳出来的窗口中,

将我给的代码复制进去即可。

运行代码时,点击运行即可。

让我们看一下实验效果,

操作前

操作后

为了不影响阅读,我会将代码放在最后。

收尾工作

接下来的任务,就是如何将电子稿打印到本子上了,

对于本子的选择,建议采用活页夹,这会给工作带来方便。

一般的家用普通的打印机只能打印A4的纸,

但市面上并没有A4的活页夹,所以我们之能退一步选择A5的活页夹。

因为A5是A4的二分之一,不容易造成浪费。

具体操作是

1.首先设置word的稿纸设置,

在布局里设置纸张大小是A4,方向是横向,分栏是分两栏。

2.然后将两张A5活页贴在A4纸上

3.打印,打印之后将两张A5纸背面贴成一张纸

这样一来,就大功告成啦。

如果大家有能让生活变得更美好的技巧,欢迎和舒哥分享。

附录

Sub 字体修改() ' ' 字体修改 宏 '

   Dim R_Character As Range


   Dim FontSize(5)
   ' 字体大小在5个值之间进行波动,可以改写
   FontSize(1) = "21"
   FontSize(2) = "21.5"
   FontSize(3) = "22"
   FontSize(4) = "22.5"
   FontSize(5) = "23"


   Dim FontName(3)
   '字体名称在三种字体之间进行波动,可改写,但需要保证系统拥有下列字体
   FontName(1) = "陈静的字完整版"
   FontName(2) = "萌妹子体"
   FontName(3) = "李国夫手写体"
   Dim ParagraphSpace(5)
   '行间距 在一定以下值中均等分布,可改写
   ParagraphSpace(1) = "12"
   ParagraphSpace(2) = "13"
   ParagraphSpace(3) = "20"
   ParagraphSpace(4) = "7"
   ParagraphSpace(5) = "12"
   '不懂原理的话,不建议修改下列代码
   For Each R_Character In ActiveDocument.Characters
       VBA.Randomize
       R_Character.Font.Name = FontName(Int(VBA.Rnd * 3) + 1)
       R_Character.Font.Size = FontSize(Int(VBA.Rnd * 5) + 1)
       R_Character.Font.Position = Int(VBA.Rnd * 3) + 1
       R_Character.Font.Spacing = 0


   Next
   Application.ScreenUpdating = True


   For Each Cur_Paragraph In ActiveDocument.Paragraphs
       Cur_Paragraph.LineSpacing = ParagraphSpace(Int(VBA.Rnd * 5) + 1)


   Next
       Application.ScreenUpdating = True


End Sub