module1.bas

一个用VB做的试卷分析评估系统

Attribute VB_Name = "Module1"
Public DB As Database, RS As Recordset, RS_t As Recordset, WS As Workspace, DName As String



Public mod_type As String


Public exl As Excel.Application


Function Get_Exl_Col(a As Integer) As String

  Get_Exl_Col = IntToWord(a) + ":" + IntToWord(a)

End Function


'合并Excel表中的列
Sub Unite_Exl_Col(c_begin As Integer, c_end As Integer, c_row As Integer)
Dim aa As String

  With exl
    aa = VBA.Trim(IntToWord(c_begin) + VBA.Trim(VBA.Str(c_row)) + ":" + IntToWord(c_end) + VBA.Trim(VBA.Str(c_row)))
   .Range(aa).Select
' .Range("A1:G1").Select
    With exl.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    .Selection.Merge
End With
End Sub


'合并Excel表中的行
Sub Unite_Exl_Row(c_begin As Integer, c_end As Integer, c_col As Integer)
Dim aa As String

  With exl
    aa = VBA.Trim(IntToWord(c_col) + VBA.Trim(VBA.Str(c_begin)) + ":" + IntToWord(c_col) + VBA.Trim(VBA.Str(c_end)))
   .Range(aa).Select
' .Range("A1:G1").Select
    With exl.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    .Selection.Merge
    
'    Range("E14:E19").Select
'    With Selection
'        .HorizontalAlignment = xlCenter
'        .VerticalAlignment = xlBottom
'        .WrapText = False
'        .Orientation = 0
'        .AddIndent = False
'        .IndentLevel = 0
'        .ShrinkToFit = False
'        .ReadingOrder = xlContext
'        .MergeCells = False
'    End With
'    Selection.Merge
End With
End Sub

'合并Excel表中的行和列
Sub Unite_Exl(r_begin As Integer, c_begin As Integer, r_end As Integer, c_end As Integer)
Dim aa As String

  With exl
    aa = VBA.Trim(IntToWord(c_begin) + VBA.Trim(VBA.Str(r_begin)) + ":" + IntToWord(c_end) + VBA.Trim(VBA.Str(r_end)))
   .Range(aa).Select
' .Range("A1:G1").Select
    With exl.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    .Selection.Merge
    
    
'    Range("D22:D27").Select
'    With Selection
'        .HorizontalAlignment = xlCenter
'        .VerticalAlignment = xlCenter
'        .WrapText = True
'        .Orientation = 0
'        .AddIndent = False
'        .IndentLevel = 0
'        .ShrinkToFit = False
'        .ReadingOrder = xlContext
'        .MergeCells = True
'    End With
End With
End Sub


Function IntToWord(a As Integer) As String
Dim w As String
w = "ABCDEFGHIJKLMNOPQRSTUVWXWZ"
IntToWord = VBA.Mid(w, a, 1)
End Function


'获取有效位数的小数
Function Get_Point(a As Double, n As Integer) As String
Dim b As String
b = VBA.CStr(a)
If VBA.Left(b, 1) = "." Then b = "0" + b
If InStr(b, ".") > 0 Then
      Get_Point = VBA.Mid(b, 1, InStr(b, ".") + n)
Else
   Get_Point = b + ".00"
End If

End Function