Dim TempRec1 As New ADODB.Recordset
Dim A1 As String
'Dim MyWord As Word.Application
Dim WordDoc As Word.Document
Dim BTextBox
Dim MyRange As Word.Range
Dim MyTable As Word.Table
Dim MyCell As Word.Cell
Dim MyCells As Word.Cells
Dim MyCols As Word.Columns
Dim A() As String
Dim B() As String
Dim ColN As Integer
Dim ArrBytes() As Byte
Dim FreeFileNumber As Integer
Dim Lngsize As Long
Set TempRec1.ActiveConnection = DBCon
If Combo1.ListIndex = -1 Then
MsgBox "没有选择试卷名称,不能生成试卷!", vbOKOnly, "提示"
Exit Sub
End If
TempRec1.Open "select id from sjtx where sjbm='" & SjbmArry(Combo1.ListIndex + 1) & "'"
If TempRec1.RecordCount = 0 Then
MsgBox "没有选择试卷题型顺序,不能生成试卷!", vbOKOnly, "提示"
Exit Sub
End If
TempRec1.Close
Load Form13
Form13.Height = 810
Form13.Width = 4680
CenterForm Form13, MDIForm1
Form13.Show
Me.Enabled = False
'创建新文档
On Error GoTo ErrorEnd
Start:
Set WordDoc = MyWord.Documents.Add
If Option1.Value Then
With WordDoc.PageSetup
.PageHeight = InchesToPoints(11.69)
.PageWidth = InchesToPoints(8.27)
End With
End If
If Option2.Value Then
'试卷分栏设置
WordDoc.PageSetup.TogglePortrait
With WordDoc.PageSetup
.PageHeight = InchesToPoints(11.69)
.PageWidth = InchesToPoints(16.54)
End With
WordDoc.PageSetup.TextColumns.SetCount NumColumns:=2
WordDoc.PageSetup.TextColumns.Spacing = CentimetersToPoints(4)
End If
'插入试卷名称
MyWord.Selection.Font.Name = "宋体"
MyWord.Selection.Font.Size = 16
A1$ = Trim(Combo1.Text)
MyWord.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
MyWord.Selection.TypeText A1$
MyWord.Selection.TypeText Chr(13)
'插入科目名称
MyWord.Selection.Font.Name = "宋体"
MyWord.Selection.Font.Size = 15
A1$ = "《" & Trim(Combo2.Text) & "》" + Chr(13)
MyWord.Selection.Font.Bold = True
MyWord.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
MyWord.Selection.TypeText A1$
MyWord.Selection.Font.Bold = False
'插入注意事项
If TempRec1.State = 1 Then
TempRec1.Close
End If
TempRec1.Open "select Zysx from Sjbt where Sjbm='" & SjbmArry(Combo1.ListIndex + 1) & "'"
If TempRec1.RecordCount = 0 Then
MsgBox "没有找到试卷的注意事项,不能生成试卷!", vbOKOnly, "提示"
GoTo ErrorEnd
End If
A1$ = TempRec1.Fields("Zysx").Value
MyWord.Selection.Font.Name = "黑体"
MyWord.Selection.Font.Size = 10.5
MyWord.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
MyWord.Selection.TypeText A1$
MyWord.Selection.Font.Name = "宋体"
'从Sjtx表中提取题型名称、数量、附加说明
If TempRec1.State = 1 Then
TempRec1.Close
End If
TempRec1.Open "select tx.txmc,Sjtx.Fzap,Sjtx.Fjsm from Sjtx,Tx where Sjtx.Txbm=tx.txbm and Sjtx.Sjbm='" & SjbmArry(Combo1.ListIndex + 1) & "' order by sjtx.ID"
If TempRec1.RecordCount = 0 Then
MsgBox "没有找到试卷所属题型,不能生成试卷!", vbOKOnly, "提示"
GoTo ErrorEnd
End If
ColN = TempRec1.RecordCount
If ColN < 12 Then
ReDim A(1 To TempRec1.RecordCount, 1 To 3)
TempRec1.MoveFirst
For i = 1 To TempRec1.RecordCount
A(i, 1) = TempRec1.Fields("Txmc").Value
If TempRec1.Fields("Fzap").Value <> "" Then
A(i, 2) = TempRec1.Fields("Fzap").Value
Else
A(i, 2) = ""
End If
If Trim(TempRec1.Fields("Fjsm").Value) <> "" Then
A(i, 3) = TempRec1.Fields("Fjsm").Value
Else
A(i, 3) = ""
End If
TempRec1.MoveNext
Next
TempRec1.Close
'将对应数学数字转换成中文数字
ReDim B(1 To ColN)
TempRec1.Open "select Zwsz from SdZ"
TempRec1.MoveFirst
For i = 1 To ColN
B(i) = TempRec1.Fields("Zwsz").Value
TempRec1.MoveNext
Next
TempRec1.Close
'创建表格将对应题目标号填写到表中
Set MyTable = MyWord.Selection.Tables.Add(MyWord.Selection.Range, 2, ColN + 2)
Set MyCols = MyTable.Columns
'设置列宽
MyCols(1).Width = 46.5
'列宽通过320/列数获取
For i = 1 To ColN
If Option1.Value Then
MyCols(i + 1).Width = 330 \ ColN
End If
If Option2.Value Then
MyCols(i + 1).Width = 370 \ ColN
End If
Next
MyCols(ColN + 2).Width = 50
'设置行高
MyTable.Rows(1).Height = 25
MyTable.Rows(2).Height = 25
'表格外边框
MyTable.Borders.OutsideLineStyle = wdLineStyleSingle
'表格内边框
MyTable.Borders.InsideLineStyle = wdLineStyleSingle
'表格居中
MyTable.Rows.Alignment = wdAlignRowCenter
'表格中文本对齐方式
'垂直居中
MyTable.Rows(1).Cells.VerticalAlignment = wdCellAlignVerticalCenter
MyTable.Rows(2).Cells.VerticalAlignment = wdCellAlignVerticalCenter
'水平居中
' For k = 1 To ColN + 2
' MyTable.Cell(1, k).Select
' Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
' Next
Set MyCell = MyTable.Cell(1, 1): MyCell.Select: MyWord.Selection.TypeText "题 目"
'题目名称从试卷表中的题目类型名称获取
For i = 1 To ColN
Set MyCell = MyTable.Cell(1, i + 1): MyCell.Select: MyWord.Selection.TypeText B(i)
Next
Set MyCell = MyTable.Cell(1, ColN + 2): MyCell.Select: MyWord.Selection.TypeText "总 分"
Set MyCell = MyTable.Cell(2, 1): MyCell.Select: MyWord.Selection.TypeText "得 分"
Set MyCell = Nothing
Set MyTable = Nothing
MyWord.Selection.GoToNext wdGoToLine
MyWord.Selection.TypeText Chr(13)
'可用循环生成试题
'/////
For i = 1 To ColN
'题型阅卷表格和题型说明
MyWord.Selection.Font.Name = "黑体"
Set MyTable = MyWord.Selection.Tables.Add(MyWord.Selection.Range, 2, 3)
MyTable.Borders.OutsideLineStyle = wdLineStyleSingle
MyTable.Borders.OutsideColor = wdColorWhite
MyTable.Borders.InsideLineStyle = wdLineStyleSingle
MyTable.Borders.InsideColor = wdColorWhite
MyTable.Rows(1).Cells(1).Borders.OutsideColor = wdColorBlack
MyTable.Rows(1).Cells(2).Borders.OutsideColor = wdColorBlack
MyTable.Rows(2).Cells(1).Borders.OutsideColor = wdColorBlack
MyTable.Rows(2).Cells(2).Borders.OutsideColor = wdColorBlack
Set MyRange = WordDoc.Range(MyTable.Cell(1, 3).Range.Start, MyTable.Cell(2, 3).Range.End)
MyRange.Cells.Merge
For k = 1 To 2
MyTable.Columns(k).Width = 50
Next
MyTable.Rows.Height = 25
If Option1.Value Then
MyTable.Columns(3).Width = 325
End If
If Option2.Value Then
MyTable.Columns(3).Width = 365
End If
Set MyCols = MyTable.Columns
Set MyCell = MyTable.Cell(1, 1): MyCell.Select: MyWord.Selection.TypeText "得 分"
Set MyCell = MyTable.Cell(2, 1): MyCell.Select: MyWord.Selection.TypeText "评分人"
MyTable.Rows.Alignment = wdAlignRowCenter
MyTable.Cell(1, 1).VerticalAlignment = wdCellAlignVerticalCenter
MyTable.Cell(2, 1).VerticalAlignment = wdCellAlignVerticalCenter
MyTable.Cell(1, 3).VerticalAlignment = wdCellAlignVerticalCenter
'题号+题型+分值安排
MyWord.Selection.Font.Name = "宋体"
MyWord.Selection.Font.Size = 10.5
MyWord.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
If A(i, 3) <> "" Then
Set MyCell = MyTable.Cell(1, 3): MyCell.Select: MyWord.Selection.TypeText B(i) & "、" & A(i, 1) & ".(" & A(i, 2) & ")" & Chr(10) & A(i, 3)
Else
Set MyCell = MyTable.Cell(1, 3): MyCell.Select: MyWord.Selection.TypeText B(i) & "、" & A(i, 1) & ".(" & A(i, 2) & ")"
End If
Set MyCell = MyTable.Cell(1, 3): MyCell.Select
Set MyCell = Nothing
Set MyTable = Nothing
MyWord.Selection.GoToNext wdGoToLine
MyWord.Selection.GoToNext wdGoToLine
'对应题型的试题
If TempRec1.State = 1 Then
TempRec1.Close
End If
'按难度系数升序排列试题
TempRec1.Open "select st.stnr from st,sjst where st.stbm=sjst.stbm and sjst.txmc='" & A(i, 1) & "' and sjst.Sjbm='" & SjbmArry(Combo1.ListIndex + 1) & "' order by sjst.ndxs"
If TempRec1.EOF And TempRec1.BOF Then
Exit Sub
End If
If TempRec1.RecordCount = 0 Then
MsgBox "没有找到相关试题,不能生成试卷,请检查!", vbOKOnly, "提示"
GoTo NoSt
End If
N = TempRec1.RecordCount
TempRec