?? frmrepairlist.frm
字號:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmrepairlist
Caption = "維修列表"
ClientHeight = 5445
ClientLeft = 3660
ClientTop = 2040
ClientWidth = 7275
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 5445
ScaleWidth = 7275
Begin VB.CommandButton Command2
Caption = "報 表"
Height = 375
Left = 1680
TabIndex = 3
Top = 360
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "導(dǎo)出數(shù)據(jù)"
Height = 375
Left = 360
TabIndex = 2
Top = 360
Width = 1215
End
Begin MSFlexGridLib.MSFlexGrid msglist
Height = 4455
Left = 360
TabIndex = 0
Top = 720
Width = 6615
_ExtentX = 11668
_ExtentY = 7858
_Version = 393216
End
Begin VB.Label lbltitle
Alignment = 2 'Center
Caption = "車輛維修信息"
BeginProperty Font
Name = "宋體"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4440
TabIndex = 1
Top = 120
Width = 2535
End
End
Attribute VB_Name = "frmrepairlist"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public txtsql As String
Dim mrc As ADODB.Recordset
Dim msgtext As String
Private Sub Command1_Click()
Call excldata
End Sub
Private Sub Command2_Click()
Dim oSHT As LLanV.LLAN_VIEW
Dim aLab() As String
Dim aTxt() As String
Dim aPer() As Double
Dim nLen As Long
Dim I As Long
ReDim aLab(3)
ReDim aTxt(3)
ReDim aPer(3)
nLen = 4
For I = 0 To 3
aPer(I) = 0.33 ''各項(xiàng)的寬度權(quán)數(shù)
Next
Dim sConDesc As String
sConDesc = "FileDSN=myconnection.dsn;UID=sa;PWD="
Set oSHT = New LLanV.LLAN_VIEW
Call oSHT.OnSetCN_STR(sConDesc)
Call oSHT.OnSetSQL("select * from repair")
'Call oSHT.OnSetPath(App.Path & "\IMG")
Call oSHT.OnRun("維修信息表", aLab, aTxt, aPer, 0)
End Sub
Private Sub Form_Load()
showtitle
showdata
Call Form_Resize
flagrEdit = True
' flagtoexcel = 4
End Sub
Private Sub Form_Resize()
If Me.WindowState <> vbMinimized And fMainForm.WindowState <> vbMinimized Then
If Me.ScaleHeight < 10 * Lbltitle.Height Then '邊界處理
Exit Sub
End If
If Me.ScaleWidth < Lbltitle.Width + Lbltitle.Width / 2 Then
Exit Sub
End If
Lbltitle.Top = Lbltitle.Height '控制控件的位置
Lbltitle.Left = (Me.Width - Lbltitle.Width) / 2
msglist.Top = Lbltitle.Top + Lbltitle.Height + Lbltitle.Height / 2
msglist.Width = Me.ScaleWidth - 200
msglist.Left = Me.ScaleLeft + 100
msglist.Height = Me.ScaleHeight - msglist.Top - 200
End If
End Sub
Public Sub showtitle()
Dim I As Integer
With msglist
.Cols = 8
.TextMatrix(0, 1) = "車輛牌照"
.TextMatrix(0, 2) = "維修日期"
.TextMatrix(0, 3) = "維修部門"
.TextMatrix(0, 4) = "維修內(nèi)容"
.TextMatrix(0, 5) = "費(fèi)用(元)"
.TextMatrix(0, 6) = "維修配件"
.TextMatrix(0, 7) = "備注"
.FixedRows = 1
For I = 0 To 7
.ColAlignment(I) = 0
Next I
.FillStyle = flexFillRepeat
.Col = 0
.Row = 0
.RowSel = 1
.ColSel = .Cols - 1
.CellAlignment = 4
.ColWidth(0) = 300
.ColWidth(1) = 1000
.ColWidth(2) = 1400
.ColWidth(3) = 2000
.ColWidth(4) = 2500
.ColWidth(5) = 1400
.ColWidth(6) = 2000
.ColWidth(7) = 2400
.Row = 1
End With
End Sub
Public Sub showdata()
Dim I As Integer
Dim j As Integer
If txtsql = "" Then
txtsql = "select * from repair"
Set mrc = ExecuteSQL(txtsql, msgtext)
Else
Set mrc = ExecuteSQL(txtsql, msgtext)
If mrc.EOF = True Then
MsgBox "找不到您要查找的信息", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
End If
With msglist
.Rows = 1
Do While Not mrc.EOF
.Rows = .Rows + 1
For I = 1 To mrc.Fields.Count
If mrc.Fields(I - 1).Type = adDBDate Then
.TextMatrix(.Rows - 1, I) = Format(mrc.Fields(I - 1) & "", "yyyy-mm-dd")
Else
.TextMatrix(.Rows - 1, I) = mrc.Fields(I - 1) & ""
End If
Next I
mrc.MoveNext
Loop
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
flagrEdit = False
gintrMode = 0
Unload Me
' flagtoexcel = 0
End Sub
Private Sub msglist_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 And Shift = 0 Then
PopupMenu fMainForm.wxgl
End If
End Sub
Public Sub excldata()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim I As Long, j As Long
On Error GoTo ErrorHandle
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
For I = 0 To msglist.Rows - 1
For j = 0 To msglist.Cols - 1
xlSheet.Cells(I + 1, j + 1).Value = msglist.TextMatrix(I, j)
Next j
Next I
xlSheet.Application.Visible = True
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Exit Sub
ErrorHandle:
MsgBox "錯誤:" & Err.Number & vbCrLf & Err.Description, vbOKOnly, "運(yùn)行錯誤!"
End Sub
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -