?? 程控話單查詢.frm
字號:
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 240
TabIndex = 4
Top = 480
Width = 975
End
End
Begin VB.Label Label2
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 = &H00404080&
Height = 615
Left = 3960
TabIndex = 18
Top = 240
Width = 3855
End
End
Attribute VB_Name = "frmHDCX"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strsql As String
Dim db1 As Database
Dim kk As Integer
Private Sub cmdClose_Click()
Form15.Show
Unload Me
End Sub
Private Sub cmdFind_Click()
gdbpath = App.Path & "\"
Dim tb1 As Recordset
Dim aaa
Dim dbdxzw As Database
Dim qdfXXHD As QueryDef
Dim rsXXHD As Recordset
Dim I As Integer
Dim dbname As String
On Error GoTo ErrorHandler
If Len(Trim(txtDhhm.Text)) = 0 Then
aaa = MsgBox("請輸入電話號碼！", , "警告")
Exit Sub
Else
If Len(Trim(Text2.Text)) = 0 Then
aaa = MsgBox("請輸入密碼！", , "警告")
Exit Sub
Else
db1.Execute "drop table pwd_tmp"
db1.Execute "select * into pwd_tmp from dh_pwd where dhhm='" & txtDhhm.Text & "' and pwd='" & Text2.Text & "'"
Set tb1 = db1.OpenRecordset("pwd_tmp", 1)
If Not tb1.EOF Then
tb1.Close
Else
tb1.Close
aaa = MsgBox("密碼有誤，請重輸！", , "警告")
Exit Sub
End If
End If
End If
cmdFind.Enabled = False
cmdClose.Enabled = False
'Command1.Enabled = False
dbname = gdbpath & "Hdk_" & Trim$(Str(Year(Date))) & Trim(Str(ComboMonth.ListIndex + 1)) & ".mdb"
strsql = "SELECT * From smldmod4hb IN " & "'" & dbname & "'" & " WHERE "
Select Case Combo1.ListIndex
Case 0
strsql = strsql + " (flag = '01' or flag = '02' or flag = '03' or flag = '04' or flag = '05' or flag = '07' or flag = '10') "
Case 1
strsql = strsql + " (flag = '08' or flag = '06' or flag = '09' or flag = '11') "
Case 2
strsql = strsql + " (flag = '04' or flag = '07') "
Case 3
strsql = strsql + " flag = '05' "
Case 4
strsql = strsql + " flag = '10' "
Case 5
strsql = strsql + " flag = '01' "
Case 6
strsql = strsql + " flag = '03' "
Case 7
strsql = strsql + " flag = '02' "
End Select
If Len(Trim(txtDhhm.Text)) > 0 Then
strsql = strsql + " and TELNAR = '" & Trim(txtDhhm.Text) & "' "
End If
If Len(Trim(Text3.Text)) > 0 Then
strsql = strsql + " and date >= '" & Trim(Text3.Text) & "' "
End If
If Len(Trim(Text4.Text)) > 0 Then
strsql = strsql + " and date <= '" & Trim(Text4.Text) & "' "
End If
Call CreateQuery1(strsql)
cmdFind.Enabled = True
cmdClose.Enabled = True
MsgBox "查詢完畢"
Exit Sub
ErrorHandler:
Select Case Err.Number
Case 3376
Resume Next
Case 3024
aaa = MsgBox("該月數據不存在！", , "警告")
cmdFind.Enabled = True
cmdClose.Enabled = True
End Select
End Sub
Private Sub ComboMonth_Click()
Dim dbname As String
Dim strsql As String
On Error GoTo ErrorHandler
Exit Sub
ErrorHandler:
End Sub
Private Sub Command1_Click()
Select Case kk
Case 0
txtDhhm = txtDhhm & "1"
Case 1
Text2 = Text2 & "1"
Case 2
Text3 = Text3 & "1"
Case 3
Text4 = Text4 & "1"
End Select
End Sub
Private Sub Command10_Click()
Select Case kk
Case 0
txtDhhm = txtDhhm & "3"
Case 1
Text2 = Text2 & "3"
Case 2
Text3 = Text3 & "3"
Case 3
Text4 = Text4 & "3"
End Select
End Sub
Private Sub Command11_Click()
If kk = 3 Then
kk = 0
Else
kk = kk + 1
End If
Select Case kk
Case 0
Text1 = "請輸入電話號碼！"
Case 1
Text1 = "請輸入密碼！"
Case 2
Text1 = "請輸入起始時間！"
Case 3
Text1 = "請輸入終止時間！"
End Select
End Sub
Private Sub Command12_Click()
Select Case kk
Case 0
txtDhhm = ""
Case 1
Text2 = ""
Case 2
Text3 = ""
Case 3
Text4 = ""
End Select
End Sub
Private Sub Command2_Click()
Select Case kk
Case 0
txtDhhm = txtDhhm & "0"
Case 1
Text2 = Text2 & "0"
Case 2
Text3 = Text3 & "0"
Case 3
Text4 = Text4 & "0"
End Select
End Sub
Private Sub Command3_Click()
Select Case kk
Case 0
txtDhhm = txtDhhm & "8"
Case 1
Text2 = Text2 & "8"
Case 2
Text3 = Text3 & "8"
Case 3
Text4 = Text4 & "8"
End Select
End Sub
Private Sub Command4_Click()
Select Case kk
Case 0
txtDhhm = txtDhhm & "7"
Case 1
Text2 = Text2 & "7"
Case 2
Text3 = Text3 & "7"
Case 3
Text4 = Text4 & "7"
End Select
End Sub
Private Sub Command5_Click()
Select Case kk
Case 0
txtDhhm = txtDhhm & "9"
Case 1
Text2 = Text2 & "9"
Case 2
Text3 = Text3 & "9"
Case 3
Text4 = Text4 & "9"
End Select
End Sub
Private Sub Command6_Click()
Select Case kk
Case 0
txtDhhm = txtDhhm & "5"
Case 1
Text2 = Text2 & "5"
Case 2
Text3 = Text3 & "5"
Case 3
Text4 = Text4 & "5"
End Select
End Sub
Private Sub Command7_Click()
Select Case kk
Case 0
txtDhhm = txtDhhm & "4"
Case 1
Text2 = Text2 & "4"
Case 2
Text3 = Text3 & "4"
Case 3
Text4 = Text4 & "4"
End Select
End Sub
Private Sub Command8_Click()
Select Case kk
Case 0
txtDhhm = txtDhhm & "6"
Case 1
Text2 = Text2 & "6"
Case 2
Text3 = Text3 & "6"
Case 3
Text4 = Text4 & "6"
End Select
End Sub
Private Sub Command9_Click()
Select Case kk
Case 0
txtDhhm = txtDhhm & "2"
Case 1
Text2 = Text2 & "2"
Case 2
Text3 = Text3 & "2"
Case 3
Text4 = Text4 & "2"
End Select
End Sub
Private Sub Form_Load()
gdbpath = App.Path & "\"
Dim dbname As String
Dim strsql As String
Dim dbdxzw As Database
On Error GoTo ErrorHandler
Combo1.AddItem "詳話話單"
Combo1.AddItem "市話話單"
Combo1.AddItem "農話話單"
Combo1.AddItem "網話話單"
Combo1.AddItem "信息話單"
Combo1.AddItem "國內話單"
Combo1.AddItem "國際話單"
Combo1.AddItem "港澳話單"
Combo1.ListIndex = 0
ComboMonth.AddItem "一月"
ComboMonth.AddItem "二月"
ComboMonth.AddItem "三月"
ComboMonth.AddItem "四月"
ComboMonth.AddItem "五月"
ComboMonth.AddItem "六月"
ComboMonth.AddItem "七月"
ComboMonth.AddItem "八月"
ComboMonth.AddItem "九月"
ComboMonth.AddItem "十月"
ComboMonth.AddItem "十一月"
ComboMonth.AddItem "十二月"
ComboMonth.ListIndex = Month(Date) - 1
kk = 0
Text1 = "請輸入電話號碼！"
Set db1 = DBEngine.Workspaces(0).OpenDatabase(gdbpath & "zj.mdb")
Exit Sub
ErrorHandler:
End Sub
Sub CreateQuery(strsql As String)
Dim dbdxzw As Database
Dim qdfXXHD As QueryDef
Dim rsXXHD As Recordset
Dim I As Integer
Set dbdxzw = DBEngine.Workspaces(0).OpenDatabase(gdbpath & "zj.mdb")
For I = 0 To dbdxzw.QueryDefs.Count - 1
If dbdxzw.QueryDefs(I).Name = "qdfXXHD" Then
dbdxzw.QueryDefs.Delete ("qdfXXHD")
Exit For
End If
Next I
Set qdfXXHD = dbdxzw.CreateQueryDef("qdfXXHD", strsql)
Set rsXXHD = qdfXXHD.OpenRecordset
Data1.DatabaseName = gdbpath & "zj.mdb"
Set Data1.Recordset = rsXXHD
Data1.Refresh
End Sub
Sub CreateQuery1(strsql As String)
gdbpath = App.Path & "\"
Dim dbdxzw As Database
Dim qdfXXHD As QueryDef
Dim rsXXHD As Recordset
Dim I As Integer
Dim fd1 As Field
Set dbdxzw = DBEngine.Workspaces(0).OpenDatabase(gdbpath & "zj.mdb")
For I = 0 To dbdxzw.QueryDefs.Count - 1
If dbdxzw.QueryDefs(I).Name = "qdfXXHD" Then
dbdxzw.QueryDefs.Delete ("qdfXXHD")
Exit For
End If
Next I
Set qdfXXHD = dbdxzw.CreateQueryDef("qdfXXHD", strsql)
Set rsXXHD = qdfXXHD.OpenRecordset
dbdxzw.Execute "UPDATE qdfXXHD SET areacode = ' ' WHERE flag>'03'"
dbdxzw.Execute "UPDATE qdfXXHD SET stime = left(stime,6)"
'dbDxzw.Execute "UPDATE qdfXXHD SET endtime = format(cdate(left(date,4)+'-'+mid(date,5,2)+'-'+right(date,2)+' '+left(stime,2)+':'+mid(stime,3,2)+':'+right(stime,2))+etime/24/3600 ,'hhmmss')"
Data1.DatabaseName = gdbpath & "zj.mdb"
Set Data1.Recordset = rsXXHD
Data1.Refresh
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmdFind.SetFocus
End If
End Sub
Private Sub Timer1_Timer()
If Label2.Left + Label2.Width < 0 Then
Label2.Left = frmHDCX.ScaleWidth
Else
Label2.Left = Label2.Left - 500
End If
End Sub
Private Sub txtDhhm_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmdFind.SetFocus
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmdFind.SetFocus
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmdFind.SetFocus
End If
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmdFind.SetFocus
End If
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -