|
|
Sub 字体修改()&#39; 字体修改 宏Dim R_Character As Range&#39; 字体大小在下列值之间进行波动，改成需要的大小，重复出现的次数越多，相应出现的概率越大，最小精度0.5Dim FontSize() As StringFontSize = Split(&#34;18.5,18.5,18.5,19,18&#34;, &#34;,&#34;)&#39;字体名称在下列字体之间进行波动，改成需要的字体，但需要保证系统拥有下列字体，可以在word查看字体名字Dim FontName() As StringFontName = Split(&#34;【嵐】芊柔体,萌妹子体,张维镜手写楷书,【嵐】芊柔体&#34;, &#34;,&#34;) &#39; 推荐字体&#39; &#34;萌妹子体,张维镜手写楷书,萌妹子体,汉仪晨妹子W,小豆岛风物诗简繁,小豆岛秋日和简繁&#34; &#39;a数值越大，行距越大，波动范围a+x, x∈[-1~1]a = 0&#39;b数值越大，字距越大，波动范围b+x, x∈[-1~1]b = 0&#39;行间距 在一定以下值中均等分布，改成需要的大小，范围c+x, x∈[0~5]c = 25For Each R_Character In ActiveDocument.CharactersVBA.Randomize&#39; 数组长度FontNameLength = UBound(FontName) - LBound(FontName)FontSizeLength = UBound(FontSize) - LBound(FontSize)&#39; 字号大小R_Character.Font.Size = FontSize(Int(VBA.Rnd * FontSizeLength) + 1)&#39; 字的上下偏移R_Character.Font.Position = Choose(Int(VBA.Rnd * 5) + 1, -1, -0.5, 0, 0.5, 1) + a&#39; 字的左右间距R_Character.Font.Spacing = Choose(Int(VBA.Rnd * 5) + 1, -1, -0.5, 0, 0.5, 1) + bIf R_Character = &#34;。&#34; Or R_Character = &#34;，&#34; Or R_Character = &#34;,&#34; Or R_Character = &#34;；&#34; Or R_Character = &#34;’&#34; Or R_Character = &#34;‘&#34; Or R_Character = &#34;“&#34; Or R_Character = &#34;”&#34; Or R_Character = &#34;！&#34; Or R_Character = &#34;？&#34; Or R_Character = &#34;、&#34; Or R_Character = &#34;：&#34; Then&#39; 中文常用标点符号&#39; 标点固定用以下字体R_Character.Font.Name = &#34;张维镜手写楷书&#34;&#39; 标点随机用FontName中字体&#39;R_Character.Font.Name = FontName(Int(VBA.Rnd * FontSizeLength))ElseIf Asc(R_Character) >= 48 And Asc(R_Character) <= 57 Then&#39; 数字R_Character.Font.Name = &#34;【嵐】芊柔体&#34;ElseIf Asc(R_Character) >= 97 And Asc(R_Character) <= 122 Or Asc(R_Character) >= 65 And Asc(R_Character) <= 90 Or R_Character = &#34;.&#34; Or R_Character = &#34;（&#34; Or R_Character = &#34;）&#34; Or R_Character = &#34;(&#34; Or R_Character = &#34;)&#34; Then&#39; 大小写字母R_Character.Font.Name = &#34;【嵐】芊柔体&#34;End IfNextFor Each Cur_Paragraph In ActiveDocument.Paragraphs&#39; 设置行间距类型为固定值Cur_Paragraph.LineSpacingRule = wdLineSpaceExactly&#39; 设置行间距的值Cur_Paragraph.LineSpacing = Int(VBA.Rnd * 5) + 1 + cNextSelection.Find.ClearFormattingSelection.Find.Replacement.ClearFormattingWith Selection.Find.Text = &#34;“&#34;.Replacement.Text = &#34;&#34;.Forward = True.Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = True.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllSelection.Find.ClearFormattingSelection.Find.Replacement.ClearFormattingWith Selection.Find.Text = &#34;”&#34;.Replacement.Text = &#34;&#34;.Forward = True.Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = True.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAllApplication.ScreenUpdating = TrueEnd Sub
p.s. 字体下载好后，将ttf文件复制到C:\Windows\Fonts即可完成安装。 |
|
发表于 2022-12-22 18:44:42