[求助]如何通过VBA生成一份内容相同但题号不同的试题

tangqingfu

<p>感觉好像有网友在版内提出类似的问题，但没找到该帖，就新开此帖，希望能得到帮助：</p><p>领导要求出内容相同的A、B卷，但A、B卷小题题号不能完全相同的试卷。请问能否通过VBA，以题号入手，做到在已出好的A卷试题后，分别达到以下两种B卷(如果不行，第一种也可以)</p><p>1、B卷大题的题号及其内容保持与A卷不变（如A卷的第一题是选择题，在B卷中的第一题还是选择题；A卷的第二题是口语交际，B卷的第二题也还是口语交际），但大题中的小题题号中的内容不能与A卷的相同（小题题号还是从小到大排列）,有点类似是随机抽题的做法</p><p>2、B卷大题的题号及其内容也发现变化（但题号还是从小到大排列），且各大题中的小题题号中的内容也不能与A卷的相同（小题内容还是该大题的内容，小题题号还是从小到大排列）</p><p>PS:阅读理解等题可能有多道小题</p><p>第一种情况的文档如下面附件所示：</p><p>&nbsp; d9E7gAjp.rar (23.77 KB, 下载次数: 89)

2008-9-13 15:56 上传

点击文件名下载附件
[求助]如何通过VBA生成一份内容相同但题号不同的试题

<br/></p>

[此贴子已经被作者于2008-9-13 15:56:07编辑过]

[ 本帖最后由 tangqingfu 于 2008-12-29 21:37 编辑 ]

name004

好难哦！

sylun

试试如下代码。经简单测试，一楼附件样本可通过（按第一种要求）
程序对试题格式的基本假设：需重排的各组小题均以阿拉伯数字加顿号并从1开始连续编号（假设试题内容中除上述编号外没有这样的字符组合），每小题只有一个段落（行数不限），中间一般没有空行。
Option Explicit
Dim tempRange As Range
Sub test()
Dim myRange As Range, n As Integer, myNum As Integer
Application.ScreenUpdating = False
Selection.HomeKey wdStory
With Selection.Find
    .ClearFormatting
    .MatchWildcards = True
    .Text = "[0-9]@、"
    Randomize
    Do While .Execute
        With .Parent
            n = n + 1
            If n = 1 Then
                Set tempRange = .Range
                tempRange.StartOf wdParagraph, wdExtend
            End If
            .End = .End - 1
            myNum = Val(.Text)
            .Text = Int((100 * Rnd) + 1)
            .Collapse wdCollapseEnd
            If n > 1 And myNum = 1 Then
                mySorting
                tempRange.Start = .Paragraphs(1).Range.Start
                .Collapse wdCollapseEnd
            Else
                tempRange.End = .End
                tempRange.EndOf wdParagraph, wdExtend
            End If
        End With
    Loop
    mySorting
End With
Application.ScreenUpdating = True
End Sub

Sub mySorting()
Dim c As Integer
With Selection
    tempRange.Sort FieldNumber:="段落数", SortFieldType:=wdSortFieldSyllable, Separator:=wdSortSeparateByDefaultTableSeparator
    .SetRange tempRange.Start, tempRange.Start
    Do While .Find.Execute
        If .Start > tempRange.End Then Exit Do
        c = c + 1
        .End = .End - 1
        .Text = c
        .Collapse wdCollapseEnd
    Loop
End With
End Sub

tangqingfu

To sylun兄:
复制了你的代码,运行后,提示:运行时错误'91',对像变量或with块变量未设置
能否请sylun兄把代码放到附件中?

[ 本帖最后由 tangqingfu 于 2008-12-25 22:26 编辑 ]

sylun

请楼主注意两点：一是只需执行test过程，而不是mySortting过程，二是tempRange为模块变量，该语句行应置顶。
操作上，可将上述代码文本在代码窗口置顶粘贴并运行test过程。

tangqingfu

还是和5楼一样的提示。另外，我想将代码放到normal模板中使用,在normal模板中还有多个宏，那该如何处理？

[ 本帖最后由 tangqingfu 于 2008-12-25 22:59 编辑 ]

sylun

刚才我将4楼代码文本复制粘贴测试过，并无问题，感觉无上传附件的必要。
Dim tempRange As Range语句行要置顶放在声明区，其前面不能有sub过程。楼主真的按6楼要求做了吗？
代码放在normal模板应该也一样。如果担心变量名问题，可以将tempRange改为更独特的名称，如mySortRange。

tangqingfu

还是提示:运行时错误'91',对像变量或with块变量未设置
点击"调试",
位置处于这一句:
    tempRange.Sort FieldNumber:="段落数", SortFieldType:=wdSortFieldSyllable, Separator:=wdSortSeparateByDefaultTableSeparator
请sylun兄帮忙

sylun

原帖由 tangqingfu 于 2008-12-25 23:20 发表
还是提示:运行时错误'91',对像变量或with块变量未设置
点击"调试",
位置处于这一句:
    tempRange.Sort FieldNumber:="段落数", SortFieldType:=wdSortFieldSyllable, Separator:=wdSortSeparateByDefaultTableS ...

既然这样，请楼主上传你带宏的无法运行的问题文档，我看看哪里出错吧。

tangqingfu

不好意思,弄错文档了!
可行,谢谢sylun兄!