作业赶不完怎么办？用【宏】来救急 | 快速手写作业仿真

HIFIVE 55555

已于 2022-03-20 10:58:48 修改

阅读量721

点赞数 2

于 2022-02-15 21:23:57 首次发布

本文链接：https://blog.csdn.net/hifiveee/article/details/122950026

版权

今天是元宵节了，学生党们的作业淦完了吗？我已经对作文不报希望了，忽然想到可以用电脑“仿造”几篇，网上的机器人作业代打太贵，而且邮寄慢，所以我们换一种思路：·

先制作作业纸背景
然后将作业文字“借鉴”到word文档中
运用宏将字符进行仿真（代码放后面）
打印
揉捏，并在复杂的光线中拍照
运用修图软件进一步处理（模拟光感、添加噪点、降低像素）

我们先来康康成品：

ps：如果你不满意还可以自己尝试其他的方法，欢迎留言

制作的所有附件在这里：

《作业赶不完怎么办》附件页 (id=1)http://hi.hi55555.cn/post/52

制作流程

1. 制作背景

在附件中存放了A4, B5的png, docx, pdf文件，

大家可以自行下载并修改。

其实制作过程很简单，在word中插入一个表格就可以了

2. 复制文字

为了把横线.png当背景来使用，我们需要把图片插入页眉，更改大小（图片改为“衬于文字下方”）

记得把页眉的横线覆盖，或者删除。

随后将页边距调为“窄”，然后右键在“段落”中将行距改为“固定值”。

当然我知道你们懒得做，所以在附件中包含了一个A4的模板，可以自行下载使用。

然后就可以将文字复制到上面（先不用管格式、字体、间距等，接下来就来调整）

3. 运用宏进行仿真

在word的试图>宏中创建一个宏

写入以下代码，保存并运行即可。

ps:

代码中若要更改随机字体或随机字体大小的数量（种类），需先在---[1]---处将FontName或FontSize的数量改了，再在---[2]---处将VBA.Rnd * [Num]的[Num]部分改为你需要的数量，否则会报错。
在我的测试中15磅是一个比较适中的字体大小，当然你也可以自行更改
我的字体是在iFont上找的，直接选择，无需安装，比较方便。不懂者可以自行百度iFont。

Sub 字体修改()
'
' 字体修改 宏
'
    Dim R_Character As Range

    ' ---[1]---
    Dim FontSize(5)
    ' 字体大小在5个值之间进行波动，可以改写
    FontSize(1) = "15"
    FontSize(2) = "14.5"
    FontSize(3) = "15"
    FontSize(4) = "15.5"
    FontSize(5) = "15"


    Dim FontName(10)
    '字体名称在几种字体之间进行波动，可改写，但需要保证系统拥有下列字体
    FontName(1) = "枕上情书"
    FontName(2) = "陈静的字完整版"
    FontName(3) = "字趣漫书体"
    FontName(4) = "陈静的字完整版"
    FontName(5) = "字趣星空恋人"
    FontName(6) = "来不及说我爱你"
    FontName(7) = "那年写给你的情书"
    FontName(8) = "江畔旧时月"
    FontName(9) = "甜茶味的恋爱"
    FontName(10) = "许你一世欢颜"

    Dim ParagraphSpace(5)
    '行间距 在一定以下值中均等分布，可改写
    ParagraphSpace(1) = "27"
    ParagraphSpace(2) = "27.1"
    ParagraphSpace(3) = "27"
    ParagraphSpace(4) = "26.9"
    ParagraphSpace(5) = "27"
    
    Dim FontPosition
    FontPosition = 2

    
    For Each R_Character In ActiveDocument.Characters
    ' ---[2]---
        VBA.Randomize
        R_Character.Font.Name = FontName(Int(VBA.Rnd * 10) + 1)    '字体数这里需修改
        R_Character.Font.Size = FontSize(Int(VBA.Rnd * 5) + 1)     '字体大小数这里需修改
        R_Character.Font.Position = Int(VBA.Rnd * FontPosition) + 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

对比图：