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

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

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

我们先来康康成品:

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


制作的所有附件在这里:

《作业赶不完怎么办》附件页 (id=1)icon-default.png?t=M276http://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

对比图:

 为了使效果更逼真,我们将首段的行距改为33~34磅

4. 打印,揉捏,并在复杂的光线中拍照

拍照注意:要随意地拍,为了真实性,可以先放大,再拍照,可以使图片更模糊。

光线最好是偏黄光,不要太亮,或者在后期调整也是可以。

5. 在修图软件中处理

  • 降低对比度
  • 将中段曲线稍向下拉
  • 稍稍反去雾
  • 加入少许暗角
  • 加入大量噪点
  • 在导出时将分辨率降至512px(半k?)

 如果你是polarr用户,你可以拿走我的参数。

还有,多张图片可以批量保存,又可以节省一些时间肝作业了,好耶!ヽ(✿゚▽゚)ノ

 

 


最后再附上模板链接:附件点这里

都读到这里了赶快去试试吧!

不说了我去肝作业去了。。。

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值