📄 frm当月修改.frm
字号:
Begin VB.Label lblLabels
Caption = "代扣合计:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 27
Left = 2850
TabIndex = 44
Top = 4005
Width = 1125
End
Begin VB.Label lblLabels
Caption = "应发合计:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 26
Left = 150
TabIndex = 43
Top = 4005
Width = 1125
End
Begin VB.Label lblLabels
Caption = "长城卡号:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 4
Left = 2940
TabIndex = 42
Top = 555
Width = 1125
End
Begin VB.Label lblLabels
Caption = "到职日期:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 3
Left = 180
TabIndex = 41
Top = 555
Width = 1155
End
Begin VB.Label lblLabels
Caption = "姓名:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 2
Left = 6105
TabIndex = 40
Top = 120
Width = 615
End
Begin VB.Label lblLabels
Caption = "编号:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Index = 0
Left = 195
TabIndex = 39
Top = 120
Width = 615
End
End
Attribute VB_Name = "frm数据修改"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim sq
Dim jd As Integer
Dim char As String * 1
Option Explicit
Private Sub cmd保存_Click()
On Error GoTo Err:
If Len(Trim(txtFields(0).Text)) > 0 And Len(Trim(txtFields(2).Text)) > 0 And Len(Trim(txtFields(3).Text)) > 0 Then
If Len(Trim(txtFields(4).Text)) = 18 Or Len(Trim(txtFields(4).Text)) = 0 Then
datPrimaryRS.UpdateRecord
cmd保存.Enabled = False
cmd放弃.Enabled = False
cmd增加.Enabled = True
cmd删除.Enabled = True
cmd替换.Enabled = True
cmd锁定.Enabled = True
cmd关闭.Enabled = True
cmd定位.Enabled = True
frmMAIN.StatusBar1.Panels(2).Text = "共" & Val(datPrimaryRS.Recordset.RecordCount) & "条记录"
datPrimaryRS.Recordset.Bookmark = datPrimaryRS.Recordset.LastModified
Else
yn = MsgBox("卡号位数应为18位，请核对！", 48)
End If
Else
yn = MsgBox("编号、姓名、到职日期不能为空!，请输入！", 48)
End If
Exit Sub
Err:
yn = MsgBox("编号重复或其它错误。", 48)
End Sub
Private Sub cmd定位_Click()
FHBJ = False
GH = ""
frm定位.Show 1
If FHBJ = True Then
sq = datPrimaryRS.Recordset.Bookmark
datPrimaryRS.Recordset.MoveFirst
Do While Not datPrimaryRS.Recordset.EOF And Trim(datPrimaryRS.Recordset("编号")) <> Trim(GH)
datPrimaryRS.Recordset.MoveNext
If datPrimaryRS.Recordset.EOF Then Exit Do
Loop
If datPrimaryRS.Recordset.EOF Then
yn = MsgBox("指定编号不存在！", 48)
datPrimaryRS.Recordset.Bookmark = sq
End If
End If
End Sub
Private Sub cmd放弃_Click()
datPrimaryRS.Recordset.CancelUpdate
If datPrimaryRS.Recordset.RecordCount > 0 Then
datPrimaryRS.Recordset.Bookmark = sq
End If
cmd保存.Enabled = False
cmd放弃.Enabled = False
cmd增加.Enabled = True
cmd删除.Enabled = True
cmd替换.Enabled = True
cmd锁定.Enabled = True
cmd关闭.Enabled = True
cmd定位.Enabled = True
Me.Refresh
End Sub
Private Sub cmd关闭_Click()
Screen.MousePointer = vbDefault
Unload Me
End Sub
Private Sub cmd删除_Click()
yn = MsgBox("是否真的删除?", 36)
If yn = vbYes Then
With datPrimaryRS.Recordset
If Not .EOF Then
.Delete
.MoveNext
If .EOF And .RecordCount <> 0 Then .MoveLast
If .EOF And .RecordCount = 0 Then .MoveFirst
End If
End With
End If
End Sub
Private Sub cmd锁定_Click()
If sdbj = False Then
yn = 0
frm锁定字段选择.Show 1
If FHBJ = True And yn > 0 Then
i = 5
Do While i <= 28
If i <> yn Then
lblLabels(i).Enabled = False
txtFields(i).Enabled = False
End If
i = i + 1
Loop
sdbj = True
txtFields(yn).SetFocus
cmd锁定.Caption = "解锁(&L)"
Me.Refresh
End If
Else
yn = 0
i = 5
Do While i <= 28
lblLabels(i).Enabled = True
txtFields(i).Enabled = True
i = i + 1
Loop
'sdbj = True
cmd锁定.Caption = "锁定项目(&L)"
Me.Refresh
sdbj = False
End If
End Sub
Private Sub cmd替换_Click()
frm替换选择.Show 1
If FHBJ = True Then
pb1.Visible = True
pb1.Value = 0
pb1.Max = datPrimaryRS.Recordset.RecordCount + 1
sq = datPrimaryRS.Recordset.Bookmark
datPrimaryRS.Recordset.MoveFirst
Do While Not datPrimaryRS.Recordset.EOF
datPrimaryRS.Recordset.Edit
datPrimaryRS.Recordset(THZD) = THZ
datPrimaryRS.Recordset.Update
datPrimaryRS.Recordset.MoveNext
If pb1.Value < pb1.Max Then pb1.Value = pb1.Value + 1
Loop
pb1.Visible = False
datPrimaryRS.Recordset.Bookmark = sq
Me.Refresh
End If
End Sub
Private Sub cmd增加_Click()
sq = datPrimaryRS.Recordset.Bookmark
datPrimaryRS.Recordset.AddNew
cmd保存.Enabled = True
cmd放弃.Enabled = True
cmd增加.Enabled = False
cmd删除.Enabled = False
cmd替换.Enabled = False
cmd锁定.Enabled = False
cmd关闭.Enabled = False
cmd定位.Enabled = False
txtFields(0).SetFocus
End Sub
Private Sub datPrimaryRS_Error(DataErr As Integer, Response As Integer)
'错误处理程序代码置于此处
'想要忽略错误，注释掉下一行
'想要俘获它们，在此添加代码处理它们
MsgBox "Data error event hit err:" & Error$(DataErr)
Response = 0 '忽略错误
End Sub
Private Sub datPrimaryRS_Reposition()
Screen.MousePointer = vbDefault
On Error Resume Next
'为 dynasets 和快照显示当前记录位置
datPrimaryRS.Caption = "当前记录: " & (datPrimaryRS.Recordset.AbsolutePosition + 1)
End Sub
Private Sub datPrimaryRS_Validate(Action As Integer, Save As Integer)
'验证代码置于此处
'下列动作发生时该事件被调用
Select Case Action
Case vbDataActionMoveFirst
Case vbDataActionMovePrevious
Case vbDataActionMoveNext
Case vbDataActionMoveLast
Case vbDataActionAddNew
Case vbDataActionUpdate
Case vbDataActionDelete
Case vbDataActionFind
Case vbDataActionBookmark
Case vbDataActionClose
Screen.MousePointer = vbDefault
End Select
Screen.MousePointer = vbHourglass
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyDown Then
If jd < 28 And sdbj = False And jd >= 5 Then
txtFields(jd + 1).SetFocus
SendKeys "{Home}+{End}"
Else
If sdbj = True And Not datPrimaryRS.Recordset.EOF Then
datPrimaryRS.Recordset.MoveNext
If datPrimaryRS.Recordset.EOF Then datPrimaryRS.Recordset.MoveLast
txtFields(jd).SetFocus
SendKeys "{Home}+{End}"
End If
End If
End If
If KeyCode = vbKeyUp Then
If jd > 5 And jd <= 28 And sdbj = False Then
txtFields(jd - 1).SetFocus
SendKeys "{Home}+{End}"
Else
If sdbj = True And Not datPrimaryRS.Recordset.BOF Then
datPrimaryRS.Recordset.MovePrevious
If datPrimaryRS.Recordset.BOF Then datPrimaryRS.Recordset.MoveFirst
txtFields(jd).SetFocus
SendKeys "{Home}+{End}"
End If
End If
End If
If KeyCode = vbKeyPageUp And Not datPrimaryRS.Recordset.BOF Then
datPrimaryRS.Recordset.MovePrevious
If datPrimaryRS.Recordset.BOF Then datPrimaryRS.Recordset.MoveFirst
End If
If KeyCode = vbKeyPageDown And Not datPrimaryRS.Recordset.EOF Then
datPrimaryRS.Recordset.MoveNext
If datPrimaryRS.Recordset.EOF Then datPrimaryRS.Recordset.MoveLast
End If
End Sub
Private Sub Form_Load()
pb1.Visible = False
cmd保存.Enabled = False
cmd放弃.Enabled = False
cmd增加.Enabled = True
cmd删除.Enabled = True
cmd替换.Enabled = True
cmd锁定.Enabled = True
cmd关闭.Enabled = True
cmd定位.Enabled = True
sdbj = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
Screen.MousePointer = vbDefault
End Sub
Private Sub txtFields_GotFocus(Index As Integer)
jd = Index
'SendKeys "{Home}+{End}"
TEXTF txtFields(Index)
End Sub
Private Sub txtFields_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
If jd = 0 And Not sdbj Then
txtFields(2).SetFocus
SendKeys "{Home}+{End}"
End If
If (jd < 28) And Not sdbj And (jd >= 2) Then
txtFields(jd + 1).SetFocus
Else
If sdbj = True And Not datPrimaryRS.Recordset.EOF Then
datPrimaryRS.Recordset.MoveNext
If datPrimaryRS.Recordset.EOF Then datPrimaryRS.Recordset.MoveLast
txtFields(jd).SetFocus
SendKeys "{Home}+{End}"
End If
End If
Else
If Index > 3 Then
If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = vbKeyDown Or KeyAscii = vbKeyUp Or KeyAscii = 8 Or KeyAscii = 46 Then
char = Chr(KeyAscii)
KeyAscii = Asc(char)
Else
yn = MsgBox("输入字符错误,只能输入数字、退格键?", 48, "输入错误")
KeyAscii = 0
End If
End If
End If
Debug.Print KeyAscii
If Index = 0 And (KeyAscii >= 97 And KeyAscii <= 122) Then
KeyAscii = KeyAscii - 32
End If
End Sub
Private Sub txtFields_LostFocus(Index As Integer)
If Index >= 5 Then
If Len(Trim(txtFields(Index).Text)) = 0 Then txtFields(Index).Text = "0"
End If
If Not IsDate(txtFields(3)) And Index = 3 Then
yn = MsgBox("输入日期格式为YY-MM-DD", 48, "输入错误")
txtFields(3).SetFocus
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -