'====================================================================
Sub TestsGenerate()
' макрос генерации тестов в
Word-е из Excel-я
' (КубГТУ)
' сделано в Апшеронске
Dim test_count As Integer 'количество тестов
Dim quest_count As Integer ' количество вопросов
в тесте
Dim max_quest As Integer ' общее количество
вопросов на листе
Dim list As
String ' название листа в Экселе откуда брать вопросы
Worksheets("AI").Activate ' активируем лист с входными
и выходными данными
ActiveCell.SpecialCells(xlLastCell).Select
MaxString = ActiveCell.Row
'Worksheets("0").Cells(2,
1).Value = "x"
' открываем Word
Dim WRD
Set WRD = CreateObject("Word.Application")
WRD.Visible
= True
WRD.Documents.Open
"C:\test.doc" ' Путь к файлу формата Microsoft Word, в который формировать варианты тестов
test_count
= 24 ' (здесь задаем количество вариантов)
quest_count = 5 '
(здесь задаем количество вопросов в тесте)
max_quest = 120 '
(номер максимального номера вопроса (второй столбей))
sea = 2
Randomize
For i
= 0 To test_count Step 1 ' цикл по количеству тестов
WRD.Selection.Font.Size
= 14
WRD.Selection.Font.Bold
= True
WRD.Selection.TypeText
Text:="Вариант #" + CStr(i)
WRD.Selection.Font.Bold
= wdToggle
WRD.Selection.TypeParagraph
WRD.Selection.Font.Size
= 12
' Ответы в Эксель
Worksheets("0").Cells(sea,
1).Value = "Вариант " + CStr(i)
sea = sea + 1
For j = 1 To quest_count
Step 1 ' цикл по количеству вопросов в тесте
num = Int(Rnd * max_quest)
+ 1
'MsgBox (num)
' цикл по столбцу
В, чтобы найти выбранный номер вопроса
tmp = 0
For z = 1 To MaxString Step 1
If (Int(Cells(z,
2).Value) = num) Then
'MsgBox (Cells(z, 3).Value)
tmp = z
Exit For ' вышли, запомнив z
End If
Next z
' в ыводим в Word, если найден
вопрос
If tmp = 0 Then
str1 = "Номер вопроса не
найден: " + CStr(num)
MsgBox
(str1) ' не найденный номер
End If
If tmp
<> 0 Then
WRD.Selection.Font.Bold
= True
WRD.Selection.TypeText
Text:="Вопрос #" + CStr(j)
WRD.Selection.Font.Bold
= wdToggle
WRD.Selection.TypeParagraph
WRD.Selection.TypeText
Text:=Trim(Cells(tmp,
3).Value)
WRD.Selection.TypeParagraph
' теперь цикл по количеству
вариантов ответа
For k = 1 To 4 Step
1 ' дело в том, что количество ответов может быть 2, 3 или 4
If (Int(Cells(tmp + k, 2).Value) = 0) Then
WRD.Selection.TypeText Text:=Trim(Cells(tmp + k, 4).Value) + ". " + Trim(Cells(tmp + k, 5).Value)
WRD.Selection.TypeParagraph
' Ответы в Эксель
If Len(Cells(tmp + k, 1).Value)
<> 0 Then
Worksheets("0").Cells(sea, 2).Value = j
Worksheets("0").Cells(sea, 3).Value = num
Worksheets("0").Cells(sea, 4).Value = k
sea = sea + 1
End If
Else
Exit For
End If
Next k
WRD.Selection.TypeParagraph
'WRD.Selection.InsertBreak.WdBreakType.wdSectionBreakNextPage
= True
WRD.Selection.InsertBreak (WdBreakType.wdLineBreak)
End If
Next j
sea
= sea + 1
Next i
End Sub
'====================================================================
