接上月的内容,管理系统内,如果发现输入的资料有问题,除了做必要的资料修改,另一个方式是做资料删除。同样的操作介面,我们今天来做资料删除的程式。在删除程式设计时,设计者需考虑到一个方面,若此客户在系统内已建立了后续的操作资料,比如已有消费资料或相关工程记录等,那此客户的基本资料就不可再做资料删除,以保持原始资料的完整性。

系统程式放上网后,陆续都会有网友提出讨论,若有问题,我们持续做进一步的探讨,还是一样,可以私讯、文章下留言、MAIL或SKYPE等,希望更多有兴趣的朋友加入:

VBA.jpg

 

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
 

查看原文 >>
相关文章