练习：整理文档取出答案，然后答案归位。

weiyingde

要求：
1、先对文档进行简单整理，然后将答案提到文档结尾。
2、再将试题答案归位。
一、新保险法及合规知识
（一）单选题
1.        新修订的《中华人民共和国保险法》于（    B    ）施行？
A.2009年2月28日    B.2009年10月1日   C.2009年11月1日    D.2009年9月1日

2.        我国银行业反洗钱工作的领导和监督管理机关是（   C    ）。
A.商业银行总行　　B.公安部       C.中国人民银行　　　D.银监会。

3.        “反洗钱法"在（   B    ）正式实施。
A.2006年10月1日　　B.2007年1月1日     C.2006年12月1日　　D.2007年2月1日

4.        按照反洗钱的规定，金融机构对客户的交易记录，自交易记账之日起至少保存（   B   ）年。
A.3年     B.5年      C.10年    D.15年

5.        投保人对下面哪类人员不具有投保利益（   D   ）
A.本人    B.扶养有侄女    C.配偶、子女    D.单位同事

6.        人身保险业务范围不包含以下哪种业务  （   A    ）
     A.分红保险     B.人寿保险      C.健康保险     D.意外伤害保险

7.        保险佣金可以向以下哪类人员支付（A    ）
A.个人代理人     B.员工      C.银代外勤     D.团险外勤

8.        未取得合法资格的人员从事个人代理保险活动的，由保险监督管理机构予以警告，可以并处二万元以下的罚款；情节严重的，处以（   D  ）以下的罚款
A.十万元以上二十万元以下       B.五万元以上十万元以下       C.二万元以以上五万元以下      D.二万元以上十万元以下

9.        保险公司及其分支机构自取得经营保险业务许可证之日起（ D   ）个月内，无正当理由未向工商行政管理机关办理登记的，其经营保险业务许可证失效。
A.1      B.2       C.3         D.6

10.        寿险公司可以以促销或者公益事业为目的，赠送人身保险。其中，向购买保险产品的投保人、被保险人赠送保险的，所赠送保险的保费不得超过该客户首年保费的（  D    ）；向普通消费者赠送保险的，对每人所赠送保险的保费不得超过100 元；以公益事业为目的的赠送保险不受此金额限制。
A.10%     B.8%      C.3%       D.5%

11.        自（    A     ）日起，各保险公司一律停止以撕票方式经营短期意外伤害保险
A.2009 年3 月1       B.2009 年4 月1     C.2009 年3 月10      D.2009 年3 月31

12.        各类宣传材料应由保险公司总公司或其授权的（  A  ）统一印发和管理，严禁擅自印制宣传材料或变更其内容。
A.分公司     B.中支公司    C.营销服务部      D.代理人

weiyingde

1、将文档简单处理，提出答案到文尾。
Sub 取答案()
'预处理：删除汉字之间的空格、括号内的空格、空行。
Dim isr As String
With ActiveDocument.Content
     .Find.Execute "([一-龥]@)([ ]@)([一-龥]@)", , , 1, , , 1, , , "\1\3", 2
     .Find.Execute "([\(（])(*)([A-Z])(*)([\）)])", , , 1, , , 1, , , "\1\3\5", 2 '删去括号内的空格，"([\(（])（^32@)([A-Z])(^32@)([\）)])"不能匹配，因为@代表一个以上。
     .Find.Execute "^11", , , 1, , , 1, , , "^p", 2
     .Find.Execute "^13^13", , , 1, , , 1, , , "^p", 2
     .Find.Execute "[ ]{2,}", , , 1, , , 1, , , "  ", 2
     With .Find
          Do While .Execute("[(（][A-Z][）)]", , , 1, , , 1)
                  N = N + 1
                  isr = isr & N & "." & Mid(.Parent.Text, 2, 1) & " "
          Loop
          isr = "答案：" & isr
     End With
     With ActiveDocument
         With .Range(.Range.End - 1, .Range.End - 1)
              .InsertAfter vbCr
              .InsertAfter isr
         End With
     End With
End With
ActiveDocument.Content.Find.Execute "([(（])([A-Z])([）)])", , , 1, , , 1, , , "\1  \3", 2
End Sub

weiyingde

2、再将答案归还到相应的地方。
Sub 归答案()
Dim isr As String, ar, m
With ActiveDocument.Content
     With .Find
          If .Execute("答案：*^13", , , 1) Then
             With .Parent
                  N = N + 1
                  isr = .Text
                  isr = RTrim(Replace(Replace(isr, "答案：", ""), Chr(13), ""))
                  ar = Split(isr, Chr(32))
             End With
          End If
     End With
End With
With ActiveDocument.Content
     With .Find
          Do While .Execute("[(（]^32{2}[）)]", , , 1, , , 1)
             m = m + 1
             With .Parent
                  .Text = "(" & Split(ar(m - 1), ".")(1) & ")"
                  .MoveStart 1, 1
                  .MoveEnd 1, -1
                  With .Font
                       .Bold = True: .ColorIndex = 6: .Name = "Arial Black": .Size = 14
                  End With
                  .Collapse 0
             End With
          Loop
     End With
     .Find.Execute "答案：*^13", , , 1, , , 1, , , "", 2
End With
End Sub


补充内容 (2020-5-9 21:40):
争取更完美的！

ljjldd

给力，赞一个！

ljjldd

换成数学卷子就不行呀

乐乐2006201505

weiyingde 发表于 2020-2-6 22:03
1、将文档简单处理，提出答案到文尾。
Sub 取答案()
'预处理：删除汉字之间的空格、括号内的空格、空行。 ...

最后一行修改为下面代码，可以删除题号后空格。
With ActiveDocument.Content
    .Find.Execute "([0-9]{1,2}[.])*([ ]@)*([一-龥]@)", , , 1, , , 1, , , "\1\3", 2
    .Find.Execute "([(（])([A-Z])([）)])", , , 1, , , 1, , , "\1  \3", 2
  End With还有发现下面两句没有起作用l:
（1）.Find.Execute "([一-龥]@)([ ]@)([一-龥]@)", , , 1, , , 1, , , "\1\3", 2
（2）.Find.Execute "[ ]{2,}", , , 1, , , 1, , , " ", 2

cwn41

對不地[一-龥]?看不懂這什麼字

乐乐2006201505

Sub 归解析()
  Dim isr As String, ar, m
  With ActiveDocument.Content
    With .Find
      .Execute "([0-9]{1,2}、[A-D])([解][析][：])(*^13)", , , 1, , , 1, , , "\2\1\3", 2
      Do While .Execute("[解析：][0-9]{1,2}、[A-D]*^13", , , 1, , , 1)
        n = n + 1
        isr = isr & "." & .Parent.Text
      Loop
      ar = Split(isr, ".")
    End With
  End With
Selection.HomeKey Unit:=wdStory
  Selection.Find.ClearFormatting
  Selection.Find.Replacement.ClearFormatting
  For m = 1 To n
    With Selection.Find
      .Text = "[D]．*^13"
      .Forward = True
      .Wrap = wdFindContinue
      .MatchWildcards = True
    End With
    Selection.Find.Execute
    Selection.EndKey Unit:=wdLine
    Selection.InsertAfter vbCr
    Selection.InsertAfter ar(m)
    Selection.MoveDown Unit:=wdLine, Count:=1 '将光标下移一行
    Selection.Delete
  Next
  Erase ar
End Sub