小白一枚 问一下 大神看懂的教教我怎么做
求高手挑战－word如何排版出手写效果？？为了以假乱真，我又增加了一种字体，双引号干脆不要了。但是有个问题就是效率太低了，页数多了像死机了。
Sub 手写字体()
Dim R_Character As Range
Application.ScreenUpdating = False
For Each R_Character In ActiveDocument.Characters
VBA.Randomize
If 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 = Choose(Int(VBA.Rnd * 2) + 1, "方正静蕾简体", "书体坊安景臣钢笔行书")
Else
R_Character.Font.Name = "方正静蕾简体"
End If
R_Character.Font.Size = Choose(Int(VBA.Rnd * 7) + 1, "18", "17.5", "17", "19.5", "18.5", "19", "20")
R_Character.Font.Position = Choose(Int(VBA.Rnd * 5) + 1, 1.5, 2.5, 2, 0, 1)
R_Character.Font.Spacing = Choose(Int(VBA.Rnd * 5) + 1, -1.8, -1.5, -1.6, -1.7, -1.4)
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
这段程序如何实现
大神教教我 必有重谢 原帖在这里http://club.
