求高手教路:如何将可以excel的内容
得使用宏的编程！
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。...全部
得使用宏的编程！
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。收起
