📄 hfrm306.frm
字号:
ParagraphAlign = 3
FontWeight = 700
End
Begin MSForms.Label Label3
Height = 345
Index = 4
Left = 13920
TabIndex = 5
Top = 1560
Width = 1815
BackColor = -2147483639
Caption = "嵎"
Size = "3201;609"
BorderStyle = 1
FontName = "俵俽 俹僑僔僢僋"
FontEffects = 1073741825
FontHeight = 315
FontCharSet = 128
FontPitchAndFamily= 2
ParagraphAlign = 3
FontWeight = 700
End
Begin MSForms.Label Label3
Height = 345
Index = 3
Left = 9720
TabIndex = 4
Top = 1560
Width = 1815
BackColor = -2147483639
Caption = "寁検抣"
Size = "3201;609"
BorderStyle = 1
FontName = "俵俽 俹僑僔僢僋"
FontEffects = 1073741825
FontHeight = 315
FontCharSet = 128
FontPitchAndFamily= 2
ParagraphAlign = 3
FontWeight = 700
End
Begin MSForms.Label Label3
Height = 345
Index = 2
Left = 7800
TabIndex = 3
Top = 1560
Width = 1815
BackColor = -2147483639
Caption = "愝掕抣"
Size = "3201;609"
BorderStyle = 1
FontName = "俵俽 俹僑僔僢僋"
FontEffects = 1073741825
FontHeight = 315
FontCharSet = 128
FontPitchAndFamily= 2
ParagraphAlign = 3
FontWeight = 700
End
Begin MSForms.Label Label3
Height = 345
Index = 1
Left = 2280
TabIndex = 2
Top = 1560
Width = 5415
BackColor = -2147483639
Caption = "柫暱柤"
Size = "9551;609"
BorderStyle = 1
FontName = "俵俽 俹僑僔僢僋"
FontEffects = 1073741825
FontHeight = 315
FontCharSet = 128
FontPitchAndFamily= 2
ParagraphAlign = 3
FontWeight = 700
End
Begin MSForms.Label Label3
Height = 345
Index = 0
Left = 600
TabIndex = 1
Top = 1560
Width = 1575
BackColor = -2147483639
Caption = "柫暱僐乕僪"
Size = "2778;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 = 0
Top = 120
Width = 7695
End
End
Attribute VB_Name = "HFrm306"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'******************************************************************************
'僔僗僥儉柤丗Hayashikane
'僾儘僌儔儉ID丗HFrm306
'僾儘僌儔儉柤丗柫暱暿弌棃崅幚愌(寧曬)
'廋惓ID 嶌惉擔 嶌惉幰 栚揑
'000丂 2007/08/10 錖孯 怴婯嶌惉
'******************************************************************************
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
'******************************************************************************
'僀儀儞僩柤: cmdPrint_Click
'婡擻 : 儗億乕僩偺報嶞(F10)
'******************************************************************************
Private Sub cmdPrint_Click()
Dim rhrfrm As New RHFrm306
On Error GoTo Err ' 僄儔乕偺応崌
If adoRes Is Nothing Or adoRes.recordcount = 0 Then
rtnVal = MsgBox(FunErrorMsg_002, vbOKOnly + 48, ErrorMsgTit306_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(ErrorMsg306_3, vbOKOnly + 64, ErrorMsgTit306_1)
Resume Resume_Err
End Sub
'******************************************************************************
'僀儀儞僩柤: cmdPrintAll_Click
'婡擻 : 儗億乕僩偺報嶞(F5)
'******************************************************************************
Private Sub cmdPrintAll_Click()
On Error GoTo Err
Call PrintFrm
Resume_Err:
Exit Sub
Err:
Resume Resume_Err
End Sub
'******************************************************************************
'僀儀儞僩柤: Dtp1_Change
'婡擻 : 帪娫傪曄峏偡傞
'******************************************************************************
Private Sub dtp1_Change()
On Error GoTo Err ' 僄儔乕偺応崌
lblExpr1.Caption = ""
lblExpr2.Caption = ""
lblExpr3.Caption = ""
lblExpr4.Caption = ""
lblExpr5.Caption = ""
lblExpr6.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
'******************************************************************************
'僀儀儞僩柤: Dtp2_Change
'婡擻 : 帪娫傪曄峏偡傞
'******************************************************************************
Private Sub dtp2_Change()
On Error GoTo Err ' 僄儔乕偺応崌
lblExpr1.Caption = ""
lblExpr2.Caption = ""
lblExpr3.Caption = ""
lblExpr4.Caption = ""
lblExpr5.Caption = ""
lblExpr6.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
'******************************************************************************
' 僀儀儞僩柤: Form_QueryUnload
' 婡擻丂丂丂: 僼僅乕儉傪暵偠側偄
'******************************************************************************
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If closeFlag Then
closeFlag = False
Cancel = 1
End If
End Sub
'******************************************************************************
'僀儀儞僩柤: Form_Unload
'婡擻 :
'******************************************************************************
Private Sub Form_Unload(Cancel As Integer)
Call DelTemp
End Sub
'******************************************************************************
' 僀儀儞僩柤: cmdClose_Click
' 婡擻丂丂丂: 僼僅乕儉傪暵偠傞(F12)
'******************************************************************************
Private Sub cmdClose_Click()
Call DelTemp
setFocusFlag = "HFrm306"
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, ErrorMsgTit306_1)
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僉乕偑墴偝傟偨偲偒偺張棟
'******************************************************************************
Private Sub fpSpread_LeaveCell(ByVal col As Long, ByVal row As Long, _
ByVal NewCol As Long, ByVal NewRow As Long, _
Cancel As Boolean)
If Not NewRow = -1 Then
txt_val.Text = NewRow
valrow = NewRow
End If
If NewCol > 2 Then
Cancel = True
End If
End Sub
'******************************************************************************
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -