VBA在管理系统的运用实例(四)
接上月的内容,管理系统内,如果发现输入的资料有问题,除了做必要的资料修改,另一个方式是做资料删除。同样的操作介面,我们今天来做资料删除的程式。在删除程式设计时,设计者需考虑到一个方面,若此客户在系统内已建立了后续的操作资料,比如已有消费资料或相关工程记录等,那此客户的基本资料就不可再做资料删除,以保持原始资料的完整性。
系统程式放上网后,陆续都会有网友提出讨论,若有问题,我们持续做进一步的探讨,还是一样,可以私讯、文章下留言、MAIL或SKYPE等,希望更多有兴趣的朋友加入:
Sub 客户的资料删除()
Application.ScreenUpdating = False
Dim Message, Title, Default, CheckSame
Dim i, j, k, ir, ic As Long
Dim m0, cif, last As Long
Dim rsf, rc, rs, rt As Long
Dim y, m, d1, d2, n, s, t As Variant
Dim d As Date
Dim r As Long
Sheets("客户").Select
ActiveSheet.Unprotect Password:="*****"
Cells(1, "N") = "资料删除"
s = Cells(22, "G")
last = Cells(1, "H")
m0 = Cells(2, "H")
cif = Cells(3, "H")
If s = "" Then
MsgBox "请先查询资料!"
Else
If m0 < 1 Then '没有Match到资料
MsgBox "资料库内无 ( " & s & " ) 的资料!"
Else
If Cells(3, "H") > 0 Then
MsgBox "压送资料已有 ( " & s & " ) 的记录,不可删除!"
Else
r = MsgBox("要删除 ( " & s & " ) 的资料?", _
vbQuestion + vbOKCancel, "确认进行删除")
If r = vbOK Then
Sheets("客户").Select
Sheets("基本资料").Visible = True
Sheets("基本资料").Select
Range(Cells(m0 + 1, "A"), Cells(last + 3, "R")).Copy
Cells(m0, "A").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("基本资料").Visible = xlVeryHidden
'以预设范围复制贴上,使用者可能从别处贴过来,复原
Sheets("客户").Select
Range("E7:M15").Copy
Range("E22").Select
ActiveSheet.Paste
Cells(21, "C") = ""
Cells(2, "N") = "资料删除"
MsgBox "选取的资料已删除!"
Else
MsgBox "删除取消", _
vbInformation + vbOKOnly, "使用者取消删除动作"
End If
End If
End If
End If
Sheets("客户").Select
Application.CutCopyMode = False
ActiveSheet.Protect Password:="*****"
Range("A3").Select
End Sub