BVA将excel题库转换为word版

62 阅读 0 评论 41 点赞

我是靠谱客的博主执着紫菜，最近开发中收集的这篇文章主要介绍BVA将excel题库转换为word版，觉得挺不错的，现在分享给大家，希望可以做个参考。

概述

'单选题有答案相关代码:
Sub 单选有答案()
Dim WdApp As Word.Application
Dim owd As Word.Document
Dim i, j As Integer
Dim Rcount, Colcount As Integer
Rcount = Sheets(1).UsedRange.Rows.Count
Colcount = 7
Set WdApp = New Word.Application
WdApp.Visible = True
Set owd = WdApp.Documents.Add
owd.Content.InsertAfter ("单选题")
owd.Content.InsertAfter (Chr(10))
For i = 2 To Rcount
owd.Content.InsertAfter (CStr(Sheets(1).Cells(i, 1)) + ". ")
owd.Content.InsertAfter (Sheets(1).Cells(i, 2))
owd.Content.InsertAfter (Chr(10))
For j = 3 To 6
owd.Content.InsertAfter (Sheets(1).Cells(1, j) + ". " + CStr(Sheets(1).Cells(i, j)) + "
") + Chr(10)
Next j
'owd.Content.InsertAfter (Chr(10))
owd.Content.InsertAfter (Sheets(1).Cells(1, 7) + "： " + Sheets(1).Cells(i, 7))
owd.Content.InsertAfter (Chr(10))
owd.Content.InsertAfter (Chr(10))
Next i
MsgBox ("jieshu")
End Sub
'单选题无答案版代码:
Sub 单选无答案()
Dim WdApp As Word.Application
Dim owd As Word.Document
Dim i, j As Integer
Dim Rcount, Colcount As Integer
Rcount = Sheets(1).UsedRange.Rows.Count
Colcount = 7
Set WdApp = New Word.Application
WdApp.Visible = True
Set owd = WdApp.Documents.Add
owd.Content.InsertAfter ("单选题")
owd.Content.InsertAfter (Chr(10))
For i = 2 To Rcount
owd.Content.InsertAfter (CStr(Sheets(1).Cells(i, 1)) + ". ")
owd.Content.InsertAfter (Sheets(1).Cells(i, 2))
owd.Content.InsertAfter (Chr(10))
For j = 3 To 6
owd.Content.InsertAfter (Sheets(1).Cells(1, j) + ". " + CStr(Sheets(1).Cells(i, j)) + "
") + Chr(10)
Next j
'owd.Content.InsertAfter (Chr(10))
'owd.Content.InsertAfter (Sheets(1).Cells(1, 10) + "： " + Sheets(1).Cells(i, 10))
owd.Content.InsertAfter (Chr(10))
owd.Content.InsertAfter (Chr(10))
Next i
MsgBox ("jieshu")
End Sub
'多选题有答案代码:
Sub 多选有答案()
Dim WdApp As Word.Application
Dim owd As Word.Document
Dim i, j As Integer
Dim Rcount, Colcount As Integer
Rcount = Sheets(2).UsedRange.Rows.Count
Colcount = 7
Set WdApp = New Word.Application
WdApp.Visible = True
Set owd = WdApp.Documents.Add
owd.Content.InsertAfter ("多选题")
owd.Content.InsertAfter (Chr(10))
For i = 2 To Rcount
owd.Content.InsertAfter (CStr(Sheets(2).Cells(i, 1)) + ". ")
owd.Content.InsertAfter (Sheets(2).Cells(i, 2))
owd.Content.InsertAfter (Chr(10))
For j = 3 To 6
owd.Content.InsertAfter (Sheets(2).Cells(1, j) + ". " + CStr(Sheets(2).Cells(i, j)) + "
") + Chr(10)
Next j
'owd.Content.InsertAfter (Chr(10))
owd.Content.InsertAfter (Sheets(2).Cells(1, 7) + "： " + Sheets(2).Cells(i, 7))
owd.Content.InsertAfter (Chr(10))
owd.Content.InsertAfter (Chr(10))
Next i
MsgBox ("jieshu")
End Sub
'多选题无答案代码:
Sub 多选无答案()
Dim WdApp As Word.Application
Dim owd As Word.Document
Dim i, j As Integer
Dim Rcount, Colcount As Integer
Rcount = Sheets(2).UsedRange.Rows.Count
Colcount = 7
Set WdApp = New Word.Application
WdApp.Visible = True
Set owd = WdApp.Documents.Add
owd.Content.InsertAfter ("多选题")
owd.Content.InsertAfter (Chr(10))
For i = 2 To Rcount
owd.Content.InsertAfter (CStr(Sheets(2).Cells(i, 1)) + ". ")
owd.Content.InsertAfter (Sheets(2).Cells(i, 2))
owd.Content.InsertAfter (Chr(10))
For j = 3 To 6
owd.Content.InsertAfter (Sheets(2).Cells(1, j) + ". " + CStr(Sheets(2).Cells(i, j)) + "
") + Chr(10)
Next j
'owd.Content.InsertAfter (Chr(10))
'owd.Content.InsertAfter (Sheets(2).Cells(1, 10) + "： " + Sheets(2).Cells(i, 10))
owd.Content.InsertAfter (Chr(10))
owd.Content.InsertAfter (Chr(10))
Next i
MsgBox ("jieshu")
End Sub
'判断无答案版:
Sub 判断无答案()
Dim WdApp As Word.Application
Dim owd As Word.Document
Dim i, j As Integer
Dim Rcount, Colcount As Integer
Rcount = Sheets(3).UsedRange.Rows.Count
Colcount = 8
Set WdApp = New Word.Application
WdApp.Visible = True
Set owd = WdApp.Documents.Add
owd.Content.InsertAfter ("判断题")
owd.Content.InsertAfter (Chr(10))
For i = 2 To Rcount
owd.Content.InsertAfter (CStr(Sheets(3).Cells(i, 1)) + ". ")
owd.Content.InsertAfter (Sheets(3).Cells(i, 2))
owd.Content.InsertAfter (Chr(10))
'owd.Content.InsertAfter (Sheets(3).Cells(1, 8) + "：" + CStr(Sheets(3).Cells(i, 8)) + "
" + CStr(Sheets(3).Cells(i, 10)))
owd.Content.InsertAfter ("答案：（
）")
owd.Content.InsertAfter (Chr(10))
owd.Content.InsertAfter (Chr(10))
Next i
MsgBox ("jieshu")
End Sub
'判断有答案版:
Sub 判断有答案()
Dim WdApp As Word.Application
Dim owd As Word.Document
Dim i, j As Integer
Dim Rcount, Colcount As Integer
Rcount = Sheets(3).UsedRange.Rows.Count
Colcount = 8
Set WdApp = New Word.Application
WdApp.Visible = True
Set owd = WdApp.Documents.Add
owd.Content.InsertAfter ("判断题")
owd.Content.InsertAfter (Chr(10))
For i = 2 To Rcount
owd.Content.InsertAfter (CStr(Sheets(3).Cells(i, 1)) + ". ")
owd.Content.InsertAfter (Sheets(3).Cells(i, 2))
owd.Content.InsertAfter (Chr(10))
owd.Content.InsertAfter (Sheets(3).Cells(1, 3) + "：" + CStr(Sheets(3).Cells(i, 3)) + "
" + CStr(Sheets(3).Cells(i, 4)))
'owd.Content.InsertAfter ("答案：（
）")
owd.Content.InsertAfter (Chr(10))
owd.Content.InsertAfter (Chr(10))
Next i
MsgBox ("jieshu")
End Sub
'简答无答案版:
Sub 简答无答案()
Dim WdApp As Word.Application
Dim owd As Word.Document
Dim i, j As Integer
Dim Rcount, Colcount As Integer
Rcount = Sheets(4).UsedRange.Rows.Count
Colcount = 8
Set WdApp = New Word.Application
WdApp.Visible = True
Set owd = WdApp.Documents.Add
owd.Content.InsertAfter ("简答题")
owd.Content.InsertAfter (Chr(10))
For i = 2 To Rcount
owd.Content.InsertAfter (CStr(Sheets(4).Cells(i, 1)) + ". ")
owd.Content.InsertAfter (Sheets(4).Cells(i, 2))
owd.Content.InsertAfter (Chr(10))
'owd.Content.InsertAfter (Sheets(4).Cells(1, 3) + "：" + CStr(Sheets(4).Cells(i, 3)))
owd.Content.InsertAfter ("答案：")
For j = 1 To 10
owd.Content.InsertAfter (Chr(10))
Next j
Next i
MsgBox ("jieshu")
End Sub
'简答有答案版:
Sub 简答有答案()
Dim WdApp As Word.Application
Dim owd As Word.Document
Dim i, j As Integer
Dim Rcount, Colcount As Integer
Rcount = Sheets(4).UsedRange.Rows.Count
Colcount = 8
Set WdApp = New Word.Application
WdApp.Visible = True
Set owd = WdApp.Documents.Add
owd.Content.InsertAfter ("简答题")
owd.Content.InsertAfter (Chr(10))
For i = 2 To Rcount
owd.Content.InsertAfter (CStr(Sheets(4).Cells(i, 1)) + ". ")
owd.Content.InsertAfter (Sheets(4).Cells(i, 2))
owd.Content.InsertAfter (Chr(10))
owd.Content.InsertAfter (Sheets(4).Cells(1, 3) + "：" + CStr(Sheets(4).Cells(i, 3)))
'owd.Content.InsertAfter ("答案：（
）")
owd.Content.InsertAfter (Chr(10))
owd.Content.InsertAfter (Chr(10))
Next i
MsgBox ("jieshu")
End Sub