📄 hfrm307.frm
字号:
FontName = "俵俽 俹僑僔僢僋"
FontEffects = 1073741825
FontHeight = 315
FontCharSet = 128
FontPitchAndFamily= 2
ParagraphAlign = 3
FontWeight = 700
End
Begin MSForms.Label Label3
Height = 345
Index = 3
Left = 10080
TabIndex = 4
Top = 1680
Width = 1935
BackColor = -2147483639
Caption = "寁検抣"
Size = "3413;609"
BorderStyle = 1
FontName = "俵俽 俹僑僔僢僋"
FontEffects = 1073741825
FontHeight = 315
FontCharSet = 128
FontPitchAndFamily= 2
ParagraphAlign = 3
FontWeight = 700
End
Begin MSForms.Label Label3
Height = 345
Index = 4
Left = 12120
TabIndex = 3
Top = 1680
Width = 2175
BackColor = -2147483639
Caption = "嵎"
Size = "3836;609"
BorderStyle = 1
FontName = "俵俽 俹僑僔僢僋"
FontEffects = 1073741825
FontHeight = 315
FontCharSet = 128
FontPitchAndFamily= 2
ParagraphAlign = 3
FontWeight = 700
End
Begin MSForms.Label Label3
Height = 345
Index = 8
Left = 14400
TabIndex = 2
Top = 1680
Width = 2175
BackColor = -2147483639
Caption = "寁検帪娫(昩)"
Size = "3836;609"
BorderStyle = 1
FontName = "俵俽 俹僑僔僢僋"
FontEffects = 1073741825
FontHeight = 315
FontCharSet = 128
FontPitchAndFamily= 2
ParagraphAlign = 3
FontWeight = 700
End
Begin VB.Label Label1
BackStyle = 0 '摟柧
Caption = "尨椏巊梡検"
BeginProperty Font
Name = "俵俽 俹僑僔僢僋"
Size = 36
Charset = 128
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 360
TabIndex = 1
Top = 120
Width = 3735
End
Begin MSForms.Label Label3
Height = 345
Index = 7
Left = 600
TabIndex = 0
Top = 960
Width = 1575
BackColor = 65535
Caption = "懳徾寧"
Size = "2778;609"
BorderStyle = 1
FontName = "俵俽 俹僑僔僢僋"
FontEffects = 1073741825
FontHeight = 315
FontCharSet = 128
FontPitchAndFamily= 2
ParagraphAlign = 3
FontWeight = 700
End
End
Attribute VB_Name = "HFrm307"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'******************************************************************************
'僔僗僥儉柤丗Hayashikane
'僾儘僌儔儉ID丗HFrm307
'僾儘僌儔儉柤丗尨椏巊梡検(寧曬)
'廋惓ID 嶌惉擔 嶌惉幰 栚揑
'000丂 2007/08/12 錖孯 怴婯嶌惉
'******************************************************************************
Option Explicit
'#####STRAT########丂掕媊丂####################################################
Private adoRes As New ADODB.Recordset
Private strSql As String
Private rtnVal
Private valrow As Long
Private KeyFlag As Boolean
Private closeFlag As Boolean
'##### END ########丂掕媊丂####################################################
'#####STRAT########丂僀儀儞僩丂################################################
'******************************************************************************
' 僀儀儞僩柤: Form_Load
' 婡擻 : 僼僅乕儉偺弶婜壔
'******************************************************************************
Private Sub Form_Load()
On Error GoTo Err
' 暵偠傞儃僞儞傪塀偡
Call HiddenClose(Me)
' 寧偺庢摼偡傞
dtp1.Value = Now()
dtp2.Value = Now()
' 僀儊乕僕傪庢摼
Call Getpic
' 僐儞儃儃僢僋僗偺僨乕僞傪庢摼偡傞
Call GetDataGrid
' 僨乕僞僌儕僢僪偺僨乕僞傪庢摼偡傞
Call GetTotleData
If adoRes.recordcount = 0 Then
txt_val.Text = 0
Else
txt_val.Text = 1
valrow = 1
End If
lblTotle.Caption = "/" & adoRes.recordcount
Resume_Err:
Exit Sub
Err:
'僄儔乕儘僌傪婰榐
WriteErrLog "HFrm306", "Form_Load", "", Err.Number, Err.Description
Resume Resume_Err
End Sub
'******************************************************************************
'僀儀儞僩柤: Form_Unload
'婡擻 :
'******************************************************************************
Private Sub Form_Unload(Cancel As Integer)
Call DelTemp
End Sub
'******************************************************************************
'僀儀儞僩柤: Dtp1_Change
'婡擻 : 帪娫傪曄峏偡傞
'******************************************************************************
Private Sub dtp1_Change()
On Error GoTo Err ' 僄儔乕偺応崌
lblExpr1.Caption = ""
lblExpr2.Caption = ""
lblExpr3.Caption = ""
lblExpr4.Caption = ""
Call GetDataGrid
Call GetTotleData
If adoRes.recordcount = 0 Then
txt_val.Text = 0
Else
txt_val.Text = 1
valrow = 1
End If
lblTotle.Caption = "/" & adoRes.recordcount
dtp1.SetFocus
Resume_Err:
Exit Sub
Err:
Resume Resume_Err
End Sub
'******************************************************************************
'僀儀儞僩柤: Dtp1_Change
'婡擻 : 帪娫傪曄峏偡傞
'******************************************************************************
Private Sub dtp2_Change()
On Error GoTo Err ' 僄儔乕偺応崌
lblExpr1.Caption = ""
lblExpr2.Caption = ""
lblExpr3.Caption = ""
lblExpr4.Caption = ""
Call GetDataGrid
Call GetTotleData
If adoRes.recordcount = 0 Then
txt_val.Text = 0
Else
txt_val.Text = 1
valrow = 1
End If
lblTotle.Caption = "/" & adoRes.recordcount
dtp2.SetFocus
Resume_Err:
Exit Sub
Err:
Resume Resume_Err
End Sub
'******************************************************************************
' 僀儀儞僩柤: cmdPrintAll_Click
' 婡擻 :
'******************************************************************************
Private Sub cmdPrintAll_Click()
On Error GoTo Err
Call PrintFrm
Resume_Err:
Exit Sub
Err:
Resume Resume_Err
End Sub
'******************************************************************************
' 僀儀儞僩柤: cmdPrintAll_Click
' 婡擻 : 儗億乕僩偺報嶞(F5)
'******************************************************************************
Private Sub cmdPrint_Click()
Dim rhrfrm As New RHFrm307
On Error GoTo Err ' 僄儔乕偺応崌
If adoRes Is Nothing Or adoRes.recordcount = 0 Then
rtnVal = MsgBox(FunErrorMsg_002, vbOKOnly + 48, ErrorMsgTit307_1)
Exit Sub
End If
Set rhrfrm.RS = adoRes
Call rhrfrm.SetDateSco(dtp1.Value, dtp2.Value)
rhrfrm.Show (1)
Resume_Err:
Exit Sub
Err:
rtnVal = MsgBox(ErrorMsg307_3, vbOKOnly + 64, ErrorMsgTit307_1)
Resume Resume_Err
End Sub
'******************************************************************************
' 僀儀儞僩柤: cmdClose_Click
' 婡擻 : 僼僅乕儉傪暵偠傞(F12)
'******************************************************************************
Private Sub cmdClose_Click()
setFocusFlag = "HFrm307"
Unload Me
End Sub
'******************************************************************************
' 僀儀儞僩柤: Form_Resize
' 婡擻 : 儂乕儉偺愝掕
'******************************************************************************
Private Sub Form_Resize()
If Not Me.WindowState = 1 Then
Me.WindowState = 2
End If
End Sub
'******************************************************************************
' 僀儀儞僩柤: btn_firstend_Click
' 婡擻 : 儗僐乕僪
'******************************************************************************
Private Sub btn_firstend_Click()
If adoRes.recordcount = 0 Then
txt_val.Text = 0
Else
txt_val.Text = 1
Call SetActiveCell(1, 1)
End If
End Sub
'******************************************************************************
' 僀儀儞僩柤: btn_last_Click
' 婡擻 : 儗僐乕僪
'******************************************************************************
Private Sub btn_last_Click()
If fpSpread.ActiveRow = 1 Then
txt_val.Text = fpSpread.ActiveRow
Else
txt_val.Text = fpSpread.ActiveRow - 1
End If
Call SetActiveCell(1, val(txt_val.Text))
End Sub
'******************************************************************************
' 僀儀儞僩柤: btn_lastend_Click
' 婡擻 : 儗僐乕僪
'******************************************************************************
Private Sub btn_lastend_Click()
txt_val.Text = adoRes.recordcount
Call SetActiveCell(1, adoRes.recordcount)
End Sub
'******************************************************************************
' 僀儀儞僩柤: btn_next_Click
' 婡擻丂丂丂: Fn僉乕偑墴偝傟偨偲偒偺張棟
'******************************************************************************
Private Sub btn_next_click()
If adoRes.recordcount = fpSpread.ActiveRow Then
txt_val.Text = fpSpread.ActiveRow
Else
txt_val.Text = fpSpread.ActiveRow + 1
End If
Call SetActiveCell(1, val(txt_val.Text))
End Sub
'******************************************************************************
' 僀儀儞僩柤: Form_KeyDown
' 婡擻丂丂丂: Fn僉乕偑墴偝傟偨偲偒偺張棟
'******************************************************************************
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo Err ' 僄儔乕偺応崌
Dim CtrlDown
CtrlDown = (Shift And vbCtrlMask) > 0
If KeyCode = VK_F12 And CtrlDown Then '
rtnVal = MsgBox(ErrorMsg301_1, vbOKOnly + 48, ErrorMsgTit301_1)
intKAKUNIN = 1
KeyFlag = False
closeFlag = True
Call cmdClose_Click '廔椆
Exit Sub
End If
If Shift > 0 Then
Exit Sub
End If
If ShortKeyPressed(KeyCode) Then
Exit Sub
End If
Select Case (KeyCode)
Case VK_F5 '報嶞丏丏丏慡僨乕僞傪報帤偡傞丅
Call cmdPrintAll_Click
KeyCode = 0
Case VK_F10 '報嶞丏丏丏慡僨乕僞傪報帤偡傞丅
Call cmdPrint_Click
KeyCode = 0
Case VK_F12
Call cmdClose_Click '廔椆
Case Else
End Select
Resume_Err:
Exit Sub
Err:
'rtnVal = MsgBox(ErrorMsg7, vbOKOnly + 64, ErrorMsgDefTit)
Resume Resume_Err
End Sub
'******************************************************************************
' 僀儀儞僩柤: fpSpread_BlockSelected
' 婡擻丂丂丂: Fn僉乕偑墴偝傟偨偲偒偺張棟
'******************************************************************************
Private Sub fpSpread_BlockSelected(ByVal BlockCol As Long, _
ByVal BlockRow As Long, _
ByVal BlockCol2 As Long, _
ByVal BlockRow2 As Long)
txt_val.Text = BlockRow
End Sub
'******************************************************************************
' 僀儀儞僩柤: fpSpread_LeaveCell
' 婡擻丂丂丂: Fn僉乕偑墴偝傟偨偲偒偺張棟
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -