📄 教室课程表查询打印窗体.frm
字号:
VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Begin VB.Form Frmclassroomfind
BackColor = &H00FFC0C0&
Caption = "教室课程表查询窗体"
ClientHeight = 10995
ClientLeft = 60
ClientTop = 345
ClientWidth = 12630
LinkTopic = "Form1"
ScaleHeight = 10995
ScaleWidth = 12630
StartUpPosition = 3 '窗口缺省
WindowState = 2 'Maximized
Begin MSAdodcLib.Adodc Adodc1
Height = 375
Left = 5760
Top = 120
Visible = 0 'False
Width = 1335
_ExtentX = 2355
_ExtentY = 661
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 1
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=Paike.mdb;Persist Security Info=False"
OLEDBString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=Paike.mdb;Persist Security Info=False"
OLEDBFile = ""
DataSourceName = ""
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin VB.CommandButton command1
BackColor = &H00FFC0C0&
Caption = "查询课程表"
BeginProperty Font
Name = "楷体_GB2312"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 1800
MaskColor = &H00FFC0C0&
Style = 1 'Graphical
TabIndex = 2
Top = 9120
Width = 2295
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "楷体_GB2312"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 495
Left = 6000
TabIndex = 0
Top = 840
Width = 2775
End
Begin VB.CommandButton Command2
BackColor = &H00FFC0C0&
Caption = "退出本界面"
BeginProperty Font
Name = "楷体_GB2312"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 615
Left = 7560
MaskColor = &H00FFC0C0&
Style = 1 'Graphical
TabIndex = 1
Top = 9120
Width = 2055
End
Begin MSDataGridLib.DataGrid DataGrid1
Bindings = "教室课程表查询打印窗体.frx":0000
Height = 6615
Left = 240
TabIndex = 3
Top = 1920
Width = 11535
_ExtentX = 20346
_ExtentY = 11668
_Version = 393216
AllowUpdate = -1 'True
ForeColor = 0
HeadLines = 1
RowHeight = 22
FormatLocked = -1 'True
BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "教室编号与教室名称对照表"
ColumnCount = 2
BeginProperty Column00
DataField = "classroomid"
Caption = "教室编号"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column01
DataField = "classroomname"
Caption = "教室名称"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
SplitCount = 1
BeginProperty Split0
BeginProperty Column00
ColumnWidth = 2940.095
EndProperty
BeginProperty Column01
ColumnWidth = 7994.835
EndProperty
EndProperty
End
Begin VB.Label Label1
BackColor = &H00C00000&
BackStyle = 0 'Transparent
Caption = "请输入要查询的教室编号："
BeginProperty Font
Name = "楷体_GB2312"
Size = 21.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 735
Left = 600
TabIndex = 4
Top = 840
Width = 5895
End
End
Attribute VB_Name = "Frmclassroomfind"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim xlapp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Public db As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim temp As New ADODB.Recordset
Dim classroomrst As New ADODB.Recordset
Dim strSQL As String
Dim strclasssql As String
'连接到数据库
Private Function ConenctToDatabase() As Boolean
On Error GoTo ErrorHandler
Dim DBName As String, ServerAdd As String, UserName As String, UserPwd As String
'设置连接信息字符串的参数
ServerAdd = "IMAGE"
DBName = "Paike.mdb"
UserName = ""
UserPwd = ""
'连接数据库
Set db = New ADODB.Connection
db.ConnectionTimeout = 10
db.CursorLocation = adUseServer
' db.ConnectionString = "uid=" & UserName & ";pwd=" & UserPwd & _
";driver={SQL Server};server=" & ServerAdd & _
";database=" & DBName & ";dsn=''"
db.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\" & DBName
db.Open
'返回值
ConenctToDatabase = True
Exit Function
ErrorHandler:
MsgBox "连接到数据库出错", vbCritical, "出现错误"
Exit Function
End Function
Private Sub Command1_Click()
Dim strClassID As String
Dim strClassroom As String
Dim i As Integer
strSQL = "SELECT * FROM bTempTableA where classroomid= " & Text1.Text & " order by ttime"
strclasssql = "select classID,classname from bclass"
strClassroom = "select * from bClassRoom where classroomid= " & Text1.Text & " "
ConenctToDatabase
rst.Open strSQL, db, adOpenKeyset, adLockOptimistic
temp.Open strclasssql, db, adOpenKeyset, adLockReadOnly
classroomrst.Open strClassroom, db, adOpenKeyset, adLockReadOnly
If rst.RecordCount() <> 0 Then
i = rst.RecordCount()
Else
MsgBox "无此信息，请重新输入！"
rst.Close
temp.Close
Exit Sub
End If
Set xlapp = New Excel.Application
Set xlbook = xlapp.Workbooks.Open(App.Path & "\课程表模板.xlt")
xlapp.Visible = True
Set xlsheet = xlbook.Worksheets("教室课程表")
xlsheet.Activate
xlsheet.Cells(5, 1) = classroomrst.Fields("classroomname")
xlsheet.Cells(5, 6) = Date
While i <> 0
strClassID = rst.Fields("classID")
temp.Filter = "classID = '" & strClassID & "'"
Select Case rst.Fields("Ttime")
Case Is = 1
xlsheet.Cells(9, 3) = temp.Fields("classname")
Case Is = 2
xlsheet.Cells(13, 3) = temp.Fields("classname")
Case Is = 3
xlsheet.Cells(17, 3) = temp.Fields("classname")
Case Is = 4
xlsheet.Cells(21, 3) = temp.Fields("classname")
Case Is = 5
xlsheet.Cells(9, 4) = temp.Fields("classname")
Case Is = 6
xlsheet.Cells(13, 4) = temp.Fields("classname")
Case Is = 7
xlsheet.Cells(17, 4) = temp.Fields("classname")
Case Is = 8
xlsheet.Cells(21, 4) = temp.Fields("classname")
Case Is = 9
xlsheet.Cells(9, 5) = temp.Fields("classname")
Case Is = 10
xlsheet.Cells(13, 5) = temp.Fields("classname")
Case Is = 11
xlsheet.Cells(17, 5) = temp.Fields("classname")
Case Is = 12
xlsheet.Cells(21, 5) = temp.Fields("classname")
Case Is = 13
xlsheet.Cells(9, 6) = temp.Fields("classname")
Case Is = 14
xlsheet.Cells(13, 6) = temp.Fields("classname")
Case Is = 15
xlsheet.Cells(17, 6) = temp.Fields("classname")
Case Is = 16
xlsheet.Cells(21, 6) = temp.Fields("classname")
Case Is = 17
xlsheet.Cells(9, 7) = temp.Fields("classname")
Case Is = 18
xlsheet.Cells(13, 7) = temp.Fields("classname")
Case Is = 19
xlsheet.Cells(17, 7) = temp.Fields("classname")
Case Is = 20
xlsheet.Cells(21, 7) = temp.Fields("classname")
Case Is = 21
xlsheet.Cells(9, 8) = temp.Fields("classname")
Case Is = 22
xlsheet.Cells(13, 8) = temp.Fields("classname")
Case Is = 23
xlsheet.Cells(17, 8) = temp.Fields("classname")
Case Is = 24
xlsheet.Cells(21, 8) = temp.Fields("classname")
Case Is = 25
xlsheet.Cells(9, 9) = temp.Fields("classname")
Case Is = 26
xlsheet.Cells(13, 9) = temp.Fields("classname")
Case Is = 27
xlsheet.Cells(17, 9) = temp.Fields("classname")
Case Is = 28
xlsheet.Cells(21, 9) = temp.Fields("classname")
Case Else
MsgBox "数据溢出，请检查系统！"
End Select
i = i - 1
rst.MoveNext
Wend
rst.Close
temp.Close
End Sub
Private Sub Command2_Click()
Unload Me
frmmain.Show vbModal
End Sub
Private Sub DataGrid1_Click()
Text1.Text = DataGrid1.Columns(0).Text
End Sub
Private Sub Form_Load()
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Paike.mdb;Persist Security Info=False"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -