form1.frm

农村水电费记帐录入

        Autosizeform frm_test_objects, frm_test_effectobjects, frm_test_startwidth, frm_test_startheight, frm_test_noofobjects, Me, , size_axis_x
    ElseIf Me.height >= frm_test_startheight And Me.width <= frm_test_startwidth Then
        Autosizeform frm_test_objects, frm_test_effectobjects, frm_test_startwidth, frm_test_startheight, frm_test_noofobjects, Me, , size_axis_y
    End If
    '------------------------------------------
   ' Text1.top = Me.height / Screen.TwipsPerPixelY - Text1.height
    'Text1.left = Me.width - Text1.width
        Me.WindowState = 2
       Autosizeform frm_test_objects, frm_test_effectobjects, frm_test_startwidth, frm_test_startheight, frm_test_noofobjects, Me

End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyRight Then keybd_event 9, 0, 0, 0
    If KeyCode = vbKeyLeft Then
        keybd_event 9, 1, 1, 0
            End If
End Sub
Private Function Start(isCanEnable As Boolean)
'isCanEnable 为真时添加可用
    With GrdMain
        .FixedRows = 0
        .Rows = 1
        .Rows = 2
        .FixedRows = 1
        .Editable = Not isCanEnable
        If Not isCanEnable Then
            GrdMain.TextMatrix(1, 0) = "001"
            .Row = 1
            .Col = 1
        End If
    End With
    CmbGx.Enabled = isCanEnable
    Dtpmake.Enabled = isCanEnable
    CmbCls.Enabled = isCanEnable
    Cmdadd.Enabled = isCanEnable
    CmdSave.Enabled = Not isCanEnable
    CmdEsc.Enabled = Not isCanEnable
    CmdExit.Enabled = True
    Me.KeyPreview = isCanEnable
End Function

Private Function chkrow(Row As Integer) As Integer
    Dim i As Integer
    With GrdMain
        If Trim(.TextMatrix(Row, 1)) = "" Or Trim(.TextMatrix(Row, 6)) = "" Then
            chkrow = -1
            Exit Function   ' 产品
        End If
        If Trim(.TextMatrix(Row, 11)) = "" Or Trim(.TextMatrix(Row, 19)) = "" Then
            chkrow = -11
            Exit Function    '人员
            
        End If
        
        If Trim(.TextMatrix(Row, 5)) = "" Or Val(Trim(.TextMatrix(Row, 5))) < 0 Then
            chkrow = -5
            Exit Function    '数量
            
        End If
        If Trim(.TextMatrix(Row, 2)) = "" And Trim(.TextMatrix(Row, 3)) = "" Then
            chkrow = -2
            Exit Function    '批号或批次
            
        End If
        
    End With
    chkrow = 1
End Function



Private Sub cmdadd_Click()

If CmbCls.Text = "" Then
    MsgBox "班次不能为空，请重新选择！", , "系统提示"
    CmbCls.SetFocus
    Exit Sub
End If
If Format(Dtpmake.Value, "yyyy-mm-dd") > Format(GetServerTime, "yyyy-mm-dd") Then
    MsgBox "日期不能早于服务器时间,请重新选择日期！", vbExclamation, "系统提示"
    Dtpmake.SetFocus
    Exit Sub
End If
If Trim(CmbGx.Text) = "" Or Trim(CmbGx.tag) = "" Then
    MsgBox "请选择工序!", , "系统提示"
    CmbGx.SetFocus
    Exit Sub
End If

If MsgBox("您录入的是否是" & Format(Dtpmake.Value, "yyyy年mm月dd日") & Trim(CmbCls.Text) & ",次班为：" & Trim(CmbCls.Text) & ",工序为：" & Trim(CmbGx.Text) & "的数据?", vbYesNo, "系统提示") = vbNo Then
    Exit Sub
End If

isSave = False
Start False
End Sub

Private Sub CmdEsc_Click()
Start True
End Sub

Private Sub Cmdexit_Click()
    Unload Me
End Sub



Private Sub Form_Load()
  With strcnn
     If .State = adStateOpen Then .Close
        .Open cnn
  End With
 ' chg.Change Me
    frm_test_startwidth = Me.width
    frm_test_startheight = Me.height
    colname = Array("记录编号", "产品名称", "产品批号", "产品批次", "未用1", "完成数量", "产品编码", "未用2", "未用3", "未用4", "未用5", "人员1", "人员2", "人员3", "人员4", "人员5", "人员6", "人员7", "人员8", "人员编码1", "人员编码2", "人员编码3", "人员编码4", "人员编码5", "人员编码6", "人员编码7", "人员编码8")
    colwd = Array(1000, 1600, 1000, 1000, 0, 1000, 0, 0, 0, 0, 0, 1000, 1000, 1000, 1000, 1000, 1000, 1000, 1000, 0, 0, 0, 0, 0, 0, 0, 0)
    coltype = Array(0, 3, 0, 0, 0, 2, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0)
    Collock = Array(1, 0, 0, 0, 1, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1)
  
  With GrdMain
    .Rows = 2
    .Cols = UBound(colname) + 1
    For i = 0 To .Cols - 1
        .ColWidth(i) = colwd(i)
        .TextMatrix(0, i) = colname(i)
        .ColInputType(i) = coltype(i)
        .ColLocked(i) = Collock(i)
        .ColAlignment(i) = flexAlignCenterCenter
    Next i
    
    
    With AdoCp
        .ConnectionString = strcnn
        .RecordSource = "select * from v_水电费记录 "
        .Refresh
    End With
'        '产品
'     Set .ListDataSource(1) = AdoCp
'     .ListSelectCol(1) = 0
'     .ListWidth(1) = 3600                  '列表宽度
'     .ShowListHeader(1) = True             '列表显示列头
'     .ListColResize(1) = True              '列表的列宽可以改变
'     .ListRowHeight(1) = 270               '列表的列高
'     .ListRows(1) = 10                     '列表显示行数
'     .ListSearchMode(1) = BinarySearch     '二分法查找
'     .ListAutoFind(1) = True
'     .ListColWidth(1, 0) = 2400
'     .ListColWidth(1, 1) = 1000
'     .ListColAlignment(1, 0) = flexAlignLeftCenter
'     .ListColAlignment(1, 1) = flexAlignLeftCenter
'     '人员
'    With AdoOP
'        .ConnectionString = strcnn
'        .RecordSource = "select cpsn_name,cpsn_num ,selcol from v_17_组装返工人员"
'        .Refresh
'    End With
'    For i = 11 To 18
'        Set .ListDataSource(i) = AdoOP
'        .ListSelectCol(i) = 2
'        .ListWidth(i) = 3000                  '列表宽度
'        .ListColWidth(i, 0) = 1500
'        .ListColWidth(i, 1) = 1500
'        .ListColWidth(i, 2) = 0
'        .ShowListHeader(i) = True             '列表显示列头
'        .ListColResize(i) = True              '列表的列宽可以改变
'        .ListRowHeight(i) = 270               '列表的列高
'        .ListRows(i) = 10                     '列表显示行数
'        .ListSearchMode(i) = BinarySearch     '二分法查找
'        .ListAutoFind(i) = True
'        .ListColAlignment(i, 1) = flexAlignLeftTop
'    Next i
'    With AdoGx
'        .ConnectionString = strcnn
'        .RecordSource = "select 工序名称,工序编码,selcol,部门编码 from v_17_组装返工工序"
'        .Refresh
'    End With
'    With CmbGx
'        Set .DataSource = AdoGx
'        .SelectCol = 2
'        .width = 4000
'        .ListColWidth(0) = 2000
'        .ListColWidth(1) = 1000
'        .ListColWidth(2) = 0
'        .ListColWidth(3) = 1000
'        .ShowHeader = True
'        .ColResize = True
'        .RowHeight = 270
'        .ListRows = 10
'        .SearchMode = LinearSearch
'        .AutoFind = True
'        .ListColAlignment(0) = flexAlignLeftCenter
'    End With
  End With
'  Dtpmake = Format(GetServerTime, "yyyy-mm-dd")
Start True
End Sub

Private Sub cmdsave_Click()
Dim rsZzFg As New ADODB.Recordset
Dim i As Integer
Dim J As Integer
Dim strbc As String
Dim recno As String
Dim RecNoi As Integer
If Trim(CmbCls.Text) = "4" Then
    strbc = "16"
Else
    If Trim(CmbCls.Text) = "8" Or Trim(CmbCls.Text) = "0" Then
        strbc = "0" & Trim(CmbCls.Text)
    Else
        MsgBox "请检查班次的录入", , "系统提示"
        Exit Sub
    End If
End If
      Dim rowi As Integer
With GrdMain
    For i = 1 To .Rows - 1
      rowi = chkrow(i)
      If rowi < 0 Then
          If i = .Rows - 1 Then
              If MsgBox("最后一行(第" & i & ")是否有效?", vbYesNo, "系统提示") = vbYes Then
                  Exit Sub
              Else
                  isSave = True
                  .Rows = .Rows - 1
                  isSave = False
                  Exit For
              End If
          Else
              MsgBox "请检查第" & i & "行" & Trim(.TextMatrix(0, 0 - rowi)) & "是否正确!", , "系统提示"
              Exit Sub
          End If
       End If
      Next i
End With
recno = putrec("ws组装车间返工", Dtpmake.Value)
RecNoi = 1
    
     With rsZzFg
      If .State = adStateOpen Then .Close
         .Open "select top 0 * from ws组装车间返工", strcnn, adOpenKeyset, adLockBatchOptimistic
     End With
    Dim ops As Integer
    
    For i = 1 To GrdMain.Rows - 1
        With rsZzFg
            .AddNew
            .Fields("记录编号") = left(recno, 8) + Format(Val(Right(recno, 3)) + RecNoi - 1, "000")
            If Trim(CmbGx.tag) <> "" Then .Fields("工序编码") = Trim(CmbGx.tag)
            .Fields("产品编号") = Trim(GrdMain.TextMatrix(i, 6))
             If Trim(GrdMain.TextMatrix(i, 2)) <> "" Then .Fields("批号") = Trim(GrdMain.TextMatrix(i, 2))
             If Trim(GrdMain.TextMatrix(i, 3)) <> "" Then .Fields("批次") = Trim(GrdMain.TextMatrix(i, 3))
            .Fields("部门") = Trim(Depcode)
            .Fields("班次") = Trim(strbc)
            .Fields("日期") = Trim(Format(Dtpmake, "yyyy-mm-dd"))
            .Fields("人员1") = Trim(GrdMain.TextMatrix(i, 19))
            RecNoi = RecNoi + 1
            ops = 1
            For J = 12 To 18
                If Trim(GrdMain.TextMatrix(i, J)) <> "" And Trim(Trim(GrdMain.TextMatrix(i, J + 8))) <> "" Then
                    .Fields(Trim("人员" & Trim(Str(J - 10)))) = Trim(GrdMain.TextMatrix(i, J + 8))
                    ops = ops + 1
                End If
            Next J
             .Fields("人数") = ops
            .Fields("完成数量") = Trim(GrdMain.TextMatrix(i, 5))
            .Fields("录入人") = Trim(frm_xtdl.Dcmbop.BoundText)
            .Fields("录入日期") = Trim(Format(GetServerTime, "yyyy-mm-dd"))
        End With
    Next i

    rsZzFg.UpdateBatch
    rsZzFg.Close
    MsgBox "数据已经保存到数据库中!"

Start True
End Sub

Private Sub grdmain_BeforeChange(Row As Integer, Col As Integer, Cancel As Boolean, newValue As String, fixed As Boolean)
If isSave Then Exit Sub '如果正在保存退出
If Col <> 1 And (Not (Col > 10 And Col < 19)) Then
    Exit Sub
End If
Dim i As Integer
With GrdMain
    
    If .GetListIndexEqual(newValue) = -1 Then
        Select Case Col
            '产品
            Case 1
                    MsgBox "产品不正确", , "系统提示"
                    .TextMatrix(Row, 1) = ""
                    .TextMatrix(Row, 6) = ""
                    Cancel = True
            '人员1-8
            Case 11, 12, 13, 14, 15, 16, 17, 18
                    MsgBox "人员" & (Col - 10) & "不正确", , "系统提示"
                    .TextMatrix(Row, Col) = ""
                    .TextMatrix(Row, Col + 8) = ""
                    Cancel = True

                    
            Case esle
        End Select
    End If


End With
End Sub
Private Sub cmbgx_KeyUp(KeyCode As Integer, Shift As Integer)
With CmbGx
    If Not .IsDropDown Then
        If KeyCode <> vbKeyEscape And KeyCode <> vbKeyUp And KeyCode <> vbKeyDown And KeyCode <> vbKeyLeft And KeyCode <> vbKeyRight And KeyCode <> vbKeyReturn Then .BeginDropDown
    End If

End With
End Sub


Private Sub GrdMain_KeyPress(KeyAscii As Integer)
    With GrdMain
        If .Col = 1 Or .Col = 2 Or .Col = 3 And KeyAscii >= 97 And KeyAscii <= 122 Then
            KeyAscii = Asc(UCase(Chr(KeyAscii)))
        End If
    End With
End Sub

Private Sub grdMain_KeyUp(KeyCode As Integer, Shift As Integer)
With GrdMain
    If Not .IsDropDown Then
        If KeyCode <> vbKeyEscape And KeyCode <> vbKeyUp And KeyCode <> vbKeyDown And KeyCode <> vbKeyLeft And KeyCode <> vbKeyRight And KeyCode <> vbKeyReturn Then .BeginDropDown
    End If

End With
End Sub

Private Sub grdmain_RowFinal(Row As Integer)
Dim rowi As Integer
If Row > 0 Then
        With GrdMain
            rowi = chkrow(Row)
            If rowi < 0 Then
                MsgBox "请检查第" & Row & "行" & Trim(.TextMatrix(0, 0 - rowi)) & "是否正确!", , "系统提示"
                Exit Sub
            End If
            If .Rows - 1 = .Row Then
            .Rows = .Rows + 1
                .TextMatrix(.Rows - 1, 0) = Format(Trim(.TextMatrix(.Rows - 2, 0) + 1), "000")
            End If
        End With
End If
End Sub

Private Sub grdMain_Selected(Row As Integer, Col As Integer, Value As String)
Dim a() As String
With GrdMain
    If .Col = 1 Then '产品
         a = Split(Value, Chr(9))
         If Trim(a(0)) <> "" Then .TextMatrix(.Row, 1) = a(0)
         If Trim(a(1)) <> "" Then .TextMatrix(.Row, 6) = a(1)
    End If
    
    If .Col > 10 And .Col < 19 Then '人员
        a = Split(Value, Chr(9))
        If Trim(a(0)) <> "" Then .TextMatrix(.Row, .Col) = a(0)
        If Trim(a(1)) <> "" Then .TextMatrix(.Row, .Col + 8) = a(1)
    End If
End With
End Sub

Private Sub grdMain_EnterCell()
    
    With GrdMain
        '更新人员数据源过滤已输入人员
        If .Row > 0 And .Col > 10 And .Col < 19 Then
            AdoOP.Recordset.Filter = "cpsn_num <>'" & Trim(.TextMatrix(.Row, 19)) & _
            "' AND cpsn_num <> '" & Trim(.TextMatrix(.Row, 20)) & _
            "' AND cpsn_num <> '" & Trim(.TextMatrix(.Row, 21)) & "' AND cpsn_num <>'" & Trim(.TextMatrix(.Row, 22)) & _
            "' AND cpsn_num <> '" & Trim(.TextMatrix(.Row, 23)) & "' AND cpsn_num <>'" & Trim(.TextMatrix(.Row, 24)) & _
            "' AND cpsn_num <> '" & Trim(.TextMatrix(.Row, 25)) & "' AND cpsn_num <>'" & Trim(.TextMatrix(.Row, 26)) & "'"
        End If
    End With

End Sub


Private Sub CmbGx_Selected(Value As String)
    With CmbGx
        a = Split(Value, Chr(9))
        If Trim(a(0)) <> "" Then .Text = a(0)
        If Trim(a(1)) <> "" Then .tag = Trim(a(1))
        If Trim(a(3)) <> "" Then Depcode = Trim(a(3))
    End With
End Sub