'单选题有答案相关代码: 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文章来源: BVA将excel题库转换为word版