求助！如何将excel生成规定格式的word文档

wayne0pao0

求救各位大虾！
本想做一个试题库，已经把试题整理到EXCEL里面了，但是现在就是想把EXCEL的试题随机抽取并生成word版的试卷。恳请各位大虾帮帮忙。
试题中有单选、多选、判断
1.每种类型的题目都放在一个sheet表中。现在就是想单选抽20题，多选10题，判断20题。应该是先生成到一个新表中吧，我把它命名为“试题抽取”。题库的题库后续会不断录入，看看有没有办法不限制住题目的数量。
2.把抽好的试题生成word格式的文档([]代表某列字段的数据)（具体实例在word文档里面）
[题目内容]
A. [A. ]
B. [B. ]
C. [C. ]
D. [D. ]
答案 [答案]
页码 [页码]
解析 [解析]
如果第一步比较麻烦，就省略掉吧。我到时候用生成随机数的方法手动生成抽取的题目。关键是第二步，如何将抽取的题目生成出符合格式要求的word文档，可能会相当麻烦，所以跪求大侠帮忙！本人感激不尽！

本人在论坛也下了一个随机生成试题的excel文档，但是试题的格式和我的不一样，如果要套用则又是个巨大的工作量！我也一起上传，共大家参考。
试题抽取.zip (24.47 KB, 下载次数: 162)

2011-8-20 21:22 上传

点击文件名下载附件
试题库与word文档格式

随机生成试卷.rar (95.71 KB, 下载次数: 174)

2011-8-20 21:22 上传

点击文件名下载附件
参考用模型

tonychris

Option Explicit


Sub CreateWord()

    Dim i As Long
    Dim k As Long
   
    Dim iRow As Long
   
    Dim tmp As String
   
    Dim strRandList() As String
   
    Dim docApp As New Word.Application  '先要引用word库
   
   
    With docApp
   
        '隐藏word文档
        .Visible = False

        '新建一个word文件
        .Documents.Add DocumentType:=wdNewBlankDocument

        '单选
        .Selection.TypeText "一、单选" & vbCrLf
        
        tmp = GetRandList(20, Sheets("单选").Cells(65536, 3).End(xlUp).Row - 1) '题目ID
        
        strRandList = Split(tmp, vbNullChar)
            
        For i = 0 To UBound(strRandList)
        
            iRow = strRandList(i) + 1 '题目ID比其所在行要少1，所以这里加1
        
            .Selection.TypeText CStr(i + 1) & ". " & Sheets("单选").Cells(iRow, 4) & vbCrLf
            
            For k = 1 To 4
            
                .Selection.TypeText Chr(k + 64) & ". " & Sheets("单选").Cells(iRow, k + 4) & vbCrLf
               
            Next
            
            .Selection.TypeText "答案 " & Sheets("单选").Cells(iRow, 9) & vbCrLf
            
            .Selection.TypeText "页码 " & Sheets("单选").Cells(iRow, 10) & vbCrLf
            
            .Selection.TypeText "解析 " & Sheets("单选").Cells(iRow, 11) & vbCrLf & vbCrLf
            
        Next
        
        '多选
        .Selection.TypeText "二、多选" & vbCrLf
        
        tmp = GetRandList(10, Sheets("多选").Cells(65536, 3).End(xlUp).Row - 1) '题目ID
        
        strRandList = Split(tmp, vbNullChar)
            
        For i = 0 To UBound(strRandList)
        
            iRow = strRandList(i) + 1 '题目ID比其所在行要少1，所以这里加1
        
            .Selection.TypeText CStr(i + 1) & ". " & Sheets("多选").Cells(iRow, 4) & vbCrLf
            
            For k = 1 To 4
            
                .Selection.TypeText Chr(k + 64) & ". " & Sheets("多选").Cells(iRow, k + 4) & vbCrLf
               
            Next
            
            .Selection.TypeText "答案 " & Sheets("多选").Cells(iRow, 9) & vbCrLf
            
            .Selection.TypeText "页码 " & Sheets("多选").Cells(iRow, 10) & vbCrLf
            
            .Selection.TypeText "解析 " & Sheets("多选").Cells(iRow, 11) & vbCrLf & vbCrLf
            
        Next

        '判断
        .Selection.TypeText "三、判断" & vbCrLf
        
        tmp = GetRandList(20, Sheets("判断").Cells(65536, 3).End(xlUp).Row - 1) '题目ID
        
        strRandList = Split(tmp, vbNullChar)
            
        For i = 0 To UBound(strRandList)
        
            iRow = strRandList(i) + 1 '题目ID比其所在行要少1，所以这里加1
        
            .Selection.TypeText CStr(i + 1) & ". " & Sheets("判断").Cells(iRow, 4) & vbCrLf
            
            For k = 1 To 2
            
                .Selection.TypeText Chr(k + 64) & ". " & Sheets("判断").Cells(iRow, k + 4) & vbCrLf
               
            Next
            
            .Selection.TypeText "答案 " & Sheets("判断").Cells(iRow, 9) & vbCrLf
            
            .Selection.TypeText "页码 " & Sheets("判断").Cells(iRow, 10) & vbCrLf
            
            .Selection.TypeText "解析 " & Sheets("判断").Cells(iRow, 11) & vbCrLf & vbCrLf
            
        Next

        '保存文件
        .ActiveDocument.SaveAs ThisWorkbook.Path + "\OK.doc"

        .ActiveDocument.Close

        .Quit
        
    End With
   
    Set docApp = Nothing
        
    MsgBox "finish !"
   
End Sub


Private Function GetRandList(ByVal RandCount As Long, ByVal upperbound As Long) As String

    Dim i As Long
   
    Dim tmp As Long
   
    Dim strResult As String
   
   
    strResult = vbNullChar
   
    For i = 1 To RandCount
   
        Randomize
        
        tmp = Int(upperbound * Rnd + 1)
        
        If InStr(strResult, vbNullChar & CStr(tmp) & vbNullChar) > 0 Then
        
            i = i - 1
            
        Else
        
            strResult = strResult & CStr(tmp) & vbNullChar 'Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
            
        End If
   
    Next

    GetRandList = Mid(strResult, 2, Len(strResult) - 2)

End Function

wayne0pao0

太感谢了，真是解决了我一个大问题，太谢谢了！

tonychris

三种试题在excel的格式有很大共通性，
中间部分的代码基本一致，所以可以提一个共同方法
程序能更清晰点，懒得弄了，自己整吧

wayne0pao0

你好，我想在把代码粘贴到其他科目的excel里面，想针对每个科目都设置一个宏，但是运行时出现“用户定义类型未定义” ，“    Dim docApp As New Word.Application  '先要引用word库 ”这一行被标注出来，不知道为什么一直没有成功！

guochangjj

学习，很需要。但具体还不会用。

hywskcel

学习了...............................

tonychris

Dim docApp As New Word.Application  
这个要在引用对话框里选择word类库

shaoxiuzhang

太好了，我也下载了。

天道酬勤y

word格式的文档的试题提取到excel中要怎么做呢