默写题随机划线

weiyingde

作为语文老师，常常要出学生默写题，出题方式基本是按照逗号、句号、问号、感叹号为间隔依据，划线设空，学生填写，此题就是为解决此种情况而设计的。如果你为语文老师，此代码一定能派上用场。
代码如下：
Sub 默写题随机划线()
Dim par As Paragraph
Dim dic As Object
'On Error Resume Next
Set RegEx = CreateObject("VBscript.RegExp")
    RegEx.Pattern = "[^\d\.．，,。！]+"
    RegEx.Global = True
     With ActiveDocument
         With .Content.Font
              .ColorIndex = wdAuto
              .Underline = wdUnderlineNone
              .Bold = False
         End With
         For Each par In .Paragraphs
             Set dic = CreateObject("scripting.dictionary")
             ssr$ = par.Range.Text
             For Each mt In RegEx.Execute(Replace(ssr, Chr(13), ""))
                 n = n + 1
                 isr = n & "|" & mt.FirstIndex & "|" & mt.Length
                 dic(isr) = ""
           
             Next
             ky = dic.keys
             m = Int(Rnd * n)
             ft = VBA.Val(Split(ky(m), "|")(1))
             lh = VBA.Val(Split(ky(m), "|")(2))
             With .Range(par.Range.Start + ft, par.Range.Start + ft + lh).Font
                  .Name = "楷体"
                  .Bold = True
                  .ColorIndex = 9
                  .Underline = wdUnderlineWavy
             End With
             Set dic = Nothing
             n = 0
         Next
     End With
End Sub

daibao88

老师不画重点，随机画，越来越不敬业了。
VBA代码水平越来越高了。

weiyingde

daibao88 发表于 2020-2-11 21:33
老师不画重点，随机画，越来越不敬业了。
VBA代码水平越来越高了。

谢谢指教。望以后多多指导！
练练手而已，这种划线题，有很多的出题方式，此为其一。

EH2003

通过随机划题，让学生知道读书要认真。

zhoujieses

版主力作，谢谢分享

duquancai

作为老师认真较好学生才是，不务正业学把精力花在VBA上。

weiyingde

duquancai 发表于 2020-3-9 12:27
作为老师认真较好学生才是，不务正业学把精力花在VBA上。

杜老师技术这么精湛，想必也是不务正业了