holdercopyp.frm

农村水电费记帐录入

      Top             =   765
      Width           =   1335
   End
   Begin VB.TextBox txtFields 
      Appearance      =   0  'Flat
      BackColor       =   &H8000000A&
      Enabled         =   0   'False
      Height          =   285
      Index           =   0
      Left            =   1440
      TabIndex        =   1
      Top             =   420
      Width           =   1335
   End
   Begin MSComCtl2.DTPicker dtpwdate 
      Height          =   375
      Index           =   0
      Left            =   1440
      TabIndex        =   13
      Top             =   1320
      Width           =   1335
      _ExtentX        =   2355
      _ExtentY        =   661
      _Version        =   393216
      Format          =   21102593
      CurrentDate     =   38393
   End
   Begin MSComCtl2.DTPicker dtpwdate 
      Height          =   375
      Index           =   1
      Left            =   5280
      TabIndex        =   14
      Top             =   1320
      Width           =   1335
      _ExtentX        =   2355
      _ExtentY        =   661
      _Version        =   393216
      Format          =   21102593
      CurrentDate     =   38393
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "抄表日期"
      Height          =   180
      Index           =   1
      Left            =   480
      TabIndex        =   18
      Top             =   1440
      Width           =   720
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "上次至码"
      Height          =   180
      Left            =   4080
      TabIndex        =   17
      Top             =   480
      Width           =   720
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "当前至码"
      Height          =   180
      Left            =   4080
      TabIndex        =   16
      Top             =   840
      Width           =   720
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "抄录日期"
      Height          =   180
      Index           =   7
      Left            =   4080
      TabIndex        =   15
      Top             =   1440
      Width           =   720
   End
   Begin VB.Label lblLabels 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "姓名："
      Height          =   180
      Index           =   1
      Left            =   720
      TabIndex        =   2
      Top             =   765
      Width           =   540
   End
   Begin VB.Label lblLabels 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "编号："
      Height          =   180
      Index           =   0
      Left            =   720
      TabIndex        =   0
      Top             =   480
      Width           =   540
   End
End
Attribute VB_Name = "usrcopyP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Combo1_Change()
  
End Sub

Private Sub cmdadd_Click()

End Sub

Private Sub cmdDelete_Click()

End Sub

Private Sub CmdAlter_Click()
Dim longPosition As Long
On Error GoTo errlable
  If Trim(txtFields(1)) = "" Then
    MsgBox "请输入正确的用户姓名!", , "信息提示"
    Exit Sub
  End If
  
  If Val(txtFields(6)) < Val(txtFields(5)) Then
      MsgBox "   数据输入错误!   ", vbInformation, "信息提示"
      Exit Sub
  End If
  If Len(txtFields(6)) = 0 Then
    MsgBox "   请输入数据!   ", vbInformation, "信息提示"
    Exit Sub
  End If
     Dim cnn As New ADODB.Connection
    Dim rstE As New ADODB.Recordset
    Dim cmdExe As New ADODB.Command
    Dim nowEv As Double
    Dim sqlAdd As String
    
    cnn.ConnectionString = cnn
    cnn.CursorLocation = adUseClient
    cnn.Open
    cmdExe.ActiveConnection = cnn
    rstE.Open "select nowecount from v_水电费记录 where  姓名ID= '" & Trim(txtFields(0)) & "'", cnn, adOpenStatic, adLockBatchOptimistic
    
    nowEv = Val(rstE.Fields(0).Value) + (Val(txtFields(6)) - Val(txtFields(5)))
    
    
    sqlAdd = "update  v_水电费记录 set LEndPCode=" & Val(txtFields(5)) & ",cEndCode=" & Val(txtFields(6)) & ",nowEcount=" & nowEv & " ,writedate=#" & dtpWdate(1) & "#  where  姓名ID= '" & Trim(txtFields(0)) & "'"
    cmdExe.CommandText = sqlAdd
    cmdExe.Execute sqlAdd
   ' cnn.Execute sqlAdd
     txtFields(5).Text = txtFields(6)
     txtFields(6) = ""
   
    cnn.Close
    
    MsgBox " 数据保存完成！ ", vbInformation
 
  txtFields(1).Enabled = False
  txtFields(5).Enabled = False
  DataGrid.Enabled = True
  datPrimaryRS.Enabled = True
  cmdFindByName.Enabled = True
  cmdFindByID.Enabled = True
  cmdExit.Enabled = True
  longPosition = datPrimaryRS.Recordset.AbsolutePosition
  datPrimaryRS.Refresh
  datPrimaryRS.Recordset.Move longPosition - 1
 
Exit Sub
errlable:
MsgBox Err.Description, , gInfo
End Sub

Private Sub cmdexit_Click()
If cmdAlter.Caption = "确认" Then
    strMessage = "您正在修改数据状态，如果现在退出，将无法保存更改。真的要退出吗?"
    intdialogtype = MB_YESNO + MB_ICONQUESTION + 256
    strtitle = "选择提示"
    intResponse = MsgBox(strMessage, intdialogtype, strtitle)
    If intResponse <> IDYES Then
        Exit Sub
    End If
End If
Unload Me
End Sub

Private Sub cmdFindByID_Click()
  Dim strname As String
  strname = InputBox("", "请输入用户编号", " ", 6400, 3980)
  If Trim(strname) <> "" Then
    datPrimaryRS.Recordset.MoveFirst
    datPrimaryRS.Recordset.Find ("姓名id='" & strname & "'")
    If datPrimaryRS.Recordset.EOF Then
      MsgBox "找不到该用户资料!", , "提示信息"
    End If
  End If
End Sub

Private Sub cmdFindByName_Click()
  Dim strname As String
  strname = InputBox("", "请输入户名", " ", 4600, 3980)
  If Trim(strname) <> "" Then
    datPrimaryRS.Recordset.MoveFirst
    datPrimaryRS.Recordset.Find ("姓名='" & strname & "'")
    If datPrimaryRS.Recordset.EOF Then
      MsgBox "找不到该用户资料!", , "提示信息"
      If datPrimaryRS.Recordset.RecordCount <> 0 Then
        datPrimaryRS.Recordset.MoveFirst
      End If
    End If
  End If
End Sub

Private Sub cmdRever_Click()
  On Error GoTo UpdateErr

  With datPrimaryRS
    .Recordset.CancelUpdate
  End With
  Exit Sub
UpdateErr:
  MsgBox Err.Description
End Sub

Private Sub cobGender_Change()
  If cobGender.Text = "男" Or cobGender.Text = "女" Then
  Else
    cobGender.Text = "男"
  End If
End Sub

Private Sub Command1_Click()
  Unload Me
End Sub



 

 

Private Sub Form_Load()
  Dim cnn As New ADODB.Command
  Dim cmd As New ADODB.Command

  Me.Top = 0: Me.Left = 0
   '若操作员为1级，就将删除按钮冻结
  datPrimaryRS.ConnectionString = gCnn '"PROVIDER=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:database password= " & DbPassword & " ;Data Source=" & AppPath & "\data\dbdb.mdb;"
  datPrimaryRS.RecordSource = "select * from v_水电费记录order by 姓名id"
  datPrimaryRS.Refresh
  Set txtFields(0).DataSource = datPrimaryRS
  txtFields(0).DataField = "姓名ID"
  Set DataGrid.DataSource = datPrimaryRS
  If gUserID = 1 Then
    DataGrid.ScrollBars = dbgAutomatic
  Else
    DataGrid.ScrollBars = dbgVertical
  End If
  
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Screen.MousePointer = vbDefault
   MDIme.loadData (txtFields(0))
Cancel = 0
End Sub

Private Sub datPrimaryRS_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)
  '错误处理程序代码置于此处
  '想要忽略错误，注释掉下一行
  '想要捕获它们，在此添加代码以处理它们
  MsgBox "输入数据有误，最后一次添加失败，原因:" & Description
End Sub

'Private Sub datPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'  '为这个 recordset 显示当前记录位置
' datPrimaryRS.Caption = datPrimaryRS.Recordset.AbsolutePosition & " of " & datPrimaryRS.Recordset.RecordCount
'End Sub

'Private Sub datPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'  '验证代码置于此处
'  '下列动作发生时该事件被调用
'  Dim bCancel As Boolean
'
'  Select Case adReason
'  Case adRsnAddNew
'  Case adRsnClose
'  Case adRsnDelete
'  Case adRsnFirstChange
'  Case adRsnMove
'  Case adRsnRequery
'  Case adRsnResynch
'  Case adRsnUndoAddNew
'  Case adRsnUndoDelete
'  Case adRsnUndoUpdate
'  Case adRsnUpdate
'  End Select
'
'  If bCancel Then adStatus = adStatusCancel
'End Sub

Private Sub cmdRefresh_Click()
  '只有多用户应用程序需要
  On Error GoTo RefreshErr

  Exit Sub
RefreshErr:
  MsgBox Err.Description
End Sub

Private Sub cmdUpdate_Click()
  On Error GoTo UpdateErr
  With datPrimaryRS
    .Enabled = True
    If .Recordset.Fields(2) = "男" Or .Recordset.Fields(2) = "女" Then
    Else
      .Recordset.Fields(2) = "男"
    End If
    .Recordset.Update
    .Recordset.MoveLast
    cmdUpdate.Enabled = False
    cmdAdd.Enabled = True
    If gUserPrivilege > 1 Then
      cmdDelete.Enabled = True
    End If
    cmdRever.Enabled = True
    DataGrid.Enabled = True
  End With

  Exit Sub
UpdateErr:
  MsgBox Err.Description
End Sub

Private Sub cmdClose_Click()
  Unload Me
End Sub

Private Sub txtFields_Change(Index As Integer)
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset

  If Index = 0 And Trim(txtFields(0)) <> "" Then
    txtFields(1) = datPrimaryRS.Recordset.Fields!姓名
    txtFields(5) = datPrimaryRS.Recordset.Fields!cendcode
 
   
   End If
   
   
End Sub

Private Sub txtFields_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii <> 8 And KeyAscii <> 46 And KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
End Sub