⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 frmreturn.frm

📁 此为我2001年为东莞建发楦头开发的企业管理软件他们使用至今,望斑竹指教! 其他会员最好不要随意下载,需经斑竹同意或我本人同意,谢谢!
💻 FRM
📖 第 1 页 / 共 3 页
字号:
🔍
123 
        Msfg.Rows = 100
        MsfgInit
        adoSecondRS.Close
        Exit Sub
    End If

    k = 1
    Do Until adoSecondRS.EOF
        Msfg.Row = k
        For l = 1 To 8
            Msfg.Col = l - 1
            If l > 2 Then Msfg.Text = Format(adoSecondRS.Fields(l - 1), "###0.00") Else Msfg.Text = adoSecondRS.Fields(l - 1)
        Next
        adoSecondRS.MoveNext
        k = k + 1
    Loop
    adoSecondRS.Close
  End If
    
      mbDataChanged = False
    
      Exit Sub
DeleteErr:
      MsgBox err.Description
    
End Sub

Private Sub cmdEdit_Click()
  'On Error GoTo EditErr
  On Error Resume Next
  
   so = InputBox("请输入退料单号", "退料单", txtfields(0).Text)
   
  If Len(so) = 0 Then
   Exit Sub
  End If
      
   Set rs = New Recordset
   rs.Open "select return_no,return_date from returnput where return_no='" & so & "'", db, adOpenStatic, adLockOptimistic
    
    If rs.RecordCount < 1 Then
        msg = MsgBox("此退料单不存在！", vbOKOnly + vbCritical, "退料单")
        rs.Close
        Set rs = Nothing
        Exit Sub
    End If
        
    rs.Close
    Set rs = Nothing
        
  Set rs = New Recordset
  rs.Open "select return_no,return_date from returnput where return_no='" & so & "'", db, adOpenStatic, adLockOptimistic
    
  If Not rs.BOF Then rs.MoveFirst
  
      For i = 0 To rs.Fields.Count - 1
       Select Case i
         Case 1
            vcDate.value = rs.Fields(i)
         Case Else
            txtfields(i) = rs.Fields(i)
        End Select
      Next
  
  rs.Close
  Set rs = Nothing
  
  With adoPrimaryRS
  If Not (.BOF And .EOF) Then
      mvBookMark = .Bookmark
  End If
  End With
    
  lblStatus.Caption = " 编辑记录"
  mbEditFlag = True
  SetButtons False
  txtfields(2).SetFocus
  
'显示记录
  mbGridFlag = True
  
  If mbGridFlag = True Then

    Dim k, l As Integer

    Dim source1 As String
    source1 = "select input_no,material_no,material_type,material_name,return_qty,material_unit,material_price,remark from returnput where return_no='" & so & "'"

    Set adoSecondRS = New Recordset
    adoSecondRS.Open source1, db, adOpenStatic, adLockOptimistic

    adoSecondRS.MoveFirst
    If adoSecondRS.BOF And adoSecondRS.EOF Then
        Msfg.Rows = 100
        MsfgInit
        adoSecondRS.Close
        Exit Sub
    End If

    k = 1
    Do Until adoSecondRS.EOF
        Msfg.Row = k
        For l = 1 To 8
            Msfg.Col = l - 1
            If l > 2 Then Msfg.Text = Format(adoSecondRS.Fields(l - 1), "###0.00") Else Msfg.Text = adoSecondRS.Fields(l - 1)
        Next
        adoSecondRS.MoveNext
        k = k + 1
    Loop
    adoSecondRS.Close
  End If
    
  Exit Sub


EditErr:
  MsgBox err.Description

End Sub

Private Sub cmdFirst_Click()
  '   On Error GoTo GoFirstError
  On Error Resume Next
    
     Beep
      
     cmdFirst.Enabled = False
     cmdPrevious.Enabled = False
     cmdNext.Enabled = True
     cmdLast.Enabled = True
     
     MsfgInit
     adoPrimaryRS.MoveFirst

    
      
      For i = 0 To adoPrimaryRS.Fields.Count - 1
       Select Case i
         Case 1
            vcDate.value = adoPrimaryRS.Fields(i)
         Case Else
            txtfields(i) = adoPrimaryRS.Fields(i)
        End Select
      Next
           
      SetButtons True
     
      mbDataChanged = False
      
  mbGridFlag = True
  
  If mbGridFlag = True Then

    Dim k, l As Integer

    Dim source1 As String
    source1 = "select input_no,material_no,material_type,material_name,return_qty,material_unit,material_price,remark  from returnput where return_no='" & txtfields(0) & "'"

    Set adoSecondRS = New Recordset
    adoSecondRS.Open source1, db, adOpenStatic, adLockOptimistic

    adoSecondRS.MoveFirst
    If adoSecondRS.BOF And adoSecondRS.EOF Then
        Msfg.Rows = 100
        MsfgInit
        adoSecondRS.Close
        Exit Sub
    End If

    k = 1
    Do Until adoSecondRS.EOF
        Msfg.Row = k
        For l = 1 To 8
            Msfg.Col = l - 1
            If l > 2 Then Msfg.Text = Format(adoSecondRS.Fields(l - 1), "###0.00") Else Msfg.Text = adoSecondRS.Fields(l - 1)
        Next
        adoSecondRS.MoveNext
        k = k + 1
    Loop
    adoSecondRS.Close
  End If
    
      mbDataChanged = False
    
      Exit Sub
      
GoFirstError:
      MsgBox err.Description


End Sub

Private Sub cmdLast_Click()
  'On Error GoTo GoLastError
  On Error Resume Next

    Beep
    cmdFirst.Enabled = True
    cmdPrevious.Enabled = True
    cmdNext.Enabled = False
    cmdLast.Enabled = False
    
    MsfgInit
    adoPrimaryRS.MoveLast

  
      For i = 0 To adoPrimaryRS.Fields.Count - 1
       Select Case i
         Case 1
            vcDate.value = adoPrimaryRS.Fields(i)
         Case Else
            txtfields(i) = adoPrimaryRS.Fields(i)
        End Select
      Next
           
      SetButtons True
     
      mbDataChanged = False
      
  mbGridFlag = True
  
  If mbGridFlag = True Then

    Dim k, l As Integer

    Dim source1 As String
    source1 = "select input_no,material_no,material_type,material_name,return_qty,material_unit,material_price,remark  from returnput where return_no='" & txtfields(0) & "'"

    Set adoSecondRS = New Recordset
    adoSecondRS.Open source1, db, adOpenStatic, adLockOptimistic

    adoSecondRS.MoveFirst
    If adoSecondRS.BOF And adoSecondRS.EOF Then
        Msfg.Rows = 100
        MsfgInit
        adoSecondRS.Close
        Exit Sub
    End If

    k = 1
    Do Until adoSecondRS.EOF
        Msfg.Row = k
        For l = 1 To 8
            Msfg.Col = l - 1
            If l > 2 Then Msfg.Text = Format(adoSecondRS.Fields(l - 1), "###0.00") Else Msfg.Text = adoSecondRS.Fields(l - 1)
        Next
        adoSecondRS.MoveNext
        k = k + 1
    Loop
    adoSecondRS.Close
  End If

  mbDataChanged = False

  Exit Sub

GoLastError:
  MsgBox err.Description

End Sub

Private Sub cmdNext_Click()
  'On Error GoTo GoNextError
  On Error Resume Next
    MsfgInit
    adoPrimaryRS.MoveNext
    
    cmdFirst.Enabled = True
    cmdPrevious.Enabled = True
    
    If adoPrimaryRS.EOF = True And adoPrimaryRS.RecordCount > 0 Then
        
        Beep
        adoPrimaryRS.MoveLast
        
        cmdNext.Enabled = False
        cmdLast.Enabled = False
    End If
    
      For i = 0 To adoPrimaryRS.Fields.Count - 1
       Select Case i
         Case 1
            vcDate.value = adoPrimaryRS.Fields(i)
         Case Else
            txtfields(i) = adoPrimaryRS.Fields(i)
        End Select
      Next
           
      SetButtons True
     
      mbDataChanged = False
      
  mbGridFlag = True
  
  If mbGridFlag = True Then

    Dim k, l As Integer

    Dim source1 As String
    source1 = "select input_no,material_no,material_type,material_name,return_qty,material_unit,material_price,remark  from returnput where return_no='" & txtfields(0) & "'"

    Set adoSecondRS = New Recordset
    adoSecondRS.Open source1, db, adOpenStatic, adLockOptimistic

    adoSecondRS.MoveFirst
    If adoSecondRS.BOF And adoSecondRS.EOF Then
        Msfg.Rows = 100
        MsfgInit
        adoSecondRS.Close
        Exit Sub
    End If

    k = 1
    Do Until adoSecondRS.EOF
        Msfg.Row = k
        For l = 1 To 8
            Msfg.Col = l - 1
            If l > 2 Then Msfg.Text = Format(adoSecondRS.Fields(l - 1), "###0.00") Else Msfg.Text = adoSecondRS.Fields(l - 1)
        Next
        adoSecondRS.MoveNext
        k = k + 1
    Loop
    adoSecondRS.Close
  End If


        
    mbDataChanged = False

    Exit Sub
GoNextError:
  MsgBox err.Description

End Sub

Private Sub cmdPrevious_Click()
  'On Error GoTo GoPrevError
    On Error Resume Next
    MsfgInit
    adoPrimaryRS.MovePrevious
        
    cmdNext.Enabled = True
    cmdLast.Enabled = True
    If adoPrimaryRS.BOF = True And adoPrimaryRS.RecordCount > 0 Then
        
        Beep
        adoPrimaryRS.MoveFirst
        
        cmdPrevious.Enabled = False
        cmdFirst.Enabled = False
    End If
    
      For i = 0 To adoPrimaryRS.Fields.Count - 1
       Select Case i
         Case 1
            vcDate.value = adoPrimaryRS.Fields(i)
         Case Else
            txtfields(i) = adoPrimaryRS.Fields(i)
        End Select
      Next
           
      SetButtons True
     
      mbDataChanged = False
      
  mbGridFlag = True
  
  If mbGridFlag = True Then

    Dim k, l As Integer

    Dim source1 As String
    source1 = "select input_no,material_no,material_type,material_name,return_qty,material_unit,material_price,remark  from returnput where return_no='" & txtfields(0) & "'"

    Set adoSecondRS = New Recordset
    adoSecondRS.Open source1, db, adOpenStatic, adLockOptimistic

    adoSecondRS.MoveFirst
    If adoSecondRS.BOF And adoSecondRS.EOF Then
        Msfg.Rows = 100
        MsfgInit
        adoSecondRS.Close
        Exit Sub
    End If

    k = 1
    Do Until adoSecondRS.EOF
        Msfg.Row = k
        For l = 1 To 8
            Msfg.Col = l - 1
            If l > 2 Then Msfg.Text = Format(adoSecondRS.Fields(l - 1), "###0.00") Else Msfg.Text = adoSecondRS.Fields(l - 1)
        Next
        adoSecondRS.MoveNext
        k = k + 1
    Loop
    adoSecondRS.Close
  End If

    mbDataChanged = False

    Exit Sub
GoPrevError:
  MsgBox err.Description
End Sub

Private Sub cmdRefresh_Click()
  '只有多用户应用程序需要
  'On Error GoTo RefreshErr
  On Error Resume Next
  MsfgInit
  adoPrimaryRS.Requery
  
  cmdFirst.Enabled = True
  cmdPrevious.Enabled = True
  cmdNext.Enabled = True
  cmdLast.Enabled = True
  
      For i = 0 To adoPrimaryRS.Fields.Count - 1
       Select Case i
         Case 1
            vcDate.value = adoPrimaryRS.Fields(i)
         Case Else
            txtfields(i) = adoPrimaryRS.Fields(i)
        End Select
      Next
           
      SetButtons True
     
      mbDataChanged = False
      
  mbGridFlag = True
  
  If mbGridFlag = True Then

    Dim k, l As Integer

    Dim source1 As String
    source1 = "select input_no,material_no,material_type,material_name,return_qty,material_unit,material_price,remark  from returnput where return_no='" & txtfields(0) & "'"

    Set adoSecondRS = New Recordset
    adoSecondRS.Open source1, db, adOpenStatic, adLockOptimistic

    adoSecondRS.MoveFirst
    If adoSecondRS.BOF And adoSecondRS.EOF Then
        Msfg.Rows = 100
        MsfgInit
        adoSecondRS.Close
        Exit Sub
    End If

    k = 1
    Do Until adoSecondRS.EOF
        Msfg.Row = k
        For l = 1 To 8
            Msfg.Col = l - 1
            If l > 2 Then Msfg.Text = Format(adoSecondRS.Fields(l - 1), "###0.00") Else Msfg.Text = adoSecondRS.Fields(l - 1)
        Next
        adoSecondRS.MoveNext
        k = k + 1
    Loop
    adoSecondRS.Close
  End If

  Exit Sub
RefreshErr:
  MsgBox err.Description

End Sub

Private Sub cmdUpdate_Click()
  'On Error GoTo UpdateErr
  On Error Resume Next
  Dim ir As Integer
           
  If mbAddNewFlag Then
  
    Msfg_LeaveCell
    If Verdict = False Then Exit Sub
    With Msfg
        'ReDim ArrayList(.Tag)
        'For ir = 1 To .Tag
        '   If Verify_List(ir, .TextMatrix(ir, 0)) = False Then Exit Sub
        'Next
        
          '退回量
        For ir = 1 To .Tag
            Set rs = New Recordset
            rs.Open "select input_qty-output_qty from input where input_no='" & .TextMatrix(ir, 0) & "' and material_no='" & .TextMatrix(ir, 1) & "'", db, adOpenStatic, adLockOptimistic
            
            If rs.RecordCount = 1 Then
                If rs.Fields(0) < Val(.TextMatrix(ir, 4)) Then MsgBox .TextMatrix(ir, 3) & "退回数量大于库存数量！", 48, "录入提示": Exit Sub
            End If
            
            rs.Close
            Set rs = Nothing
            
        Next
        
        If MsgBox("本操作将影响到退料单明细及数量,你确信以上数据正确吗?", 48 + 1, "退料单") = vbCancel Then Exit Sub
        '在此校验单号是否已经被其它用户使用
        Set rs = New Recordset
        rs.Open "select * from returnput where return_no='" & txtfields(0) & "'", db, adOpenStatic, adLockOptimistic
        
        If rs.RecordCount > 0 Then '如果已经使用则重新分配一个单号
                Dim aa As String
                Dim Mstr As String
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -