frm_search_record.frm

来自「很好一套库存管理」· FRM 代码 · 共 1,200 行 · 第 1/3 页

FRM
1,200 行
字号
123
      Picture         =   "frm_search_record.frx":0EEA
      Top             =   240
      Width           =   480
   End
   Begin VB.Image Image1 
      Height          =   495
      Left            =   3000
      Top             =   3240
      Width           =   1215
   End
   Begin VB.Label Label1 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Select Customer Name"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   255
      Index           =   0
      Left            =   120
      TabIndex        =   16
      Top             =   240
      Width           =   3255
   End
End
Attribute VB_Name = "frm_search_record"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim cust_rs As New ADODB.Recordset
Dim C_COUNT As New ADODB.Recordset
Dim cust_no As New ADODB.Recordset
Dim add_cust_rs As New ADODB.Recordset



Private Sub cmd_Click(Index As Integer)
If Index = 0 Then

        With CrystalReport1
            .DataFiles(0) = App.Path & "\Master_Database.mdb"
            .ReportFileName = App.Path & "\Report\SYSTEM_REPORT.rpt"
            .SelectionFormula = "{Customer_master.cutomer_name} = '" & Combo1.Text & "'"
            .username = "Admin"
            .Password = "1010101010" & Chr(10) & "1010101010"
            .Action = 1
            .PageZoom (100)
        End With


ElseIf Index = 2 Then
 
        Combo1.Enabled = False
        Dim cust_rs As New ADODB.Recordset
        If cmd(2).Caption = "&Modify" Then
                       SendKeys "{TAB}"
                       SendKeys "{TAB}"
                       SendKeys "{END}"
                cmd(0).Enabled = False
                cmd(1).Enabled = False
                

                LaVolpeButton1.Enabled = False
                
                For i = 1 To Text1.Count - 1
                    Text1(i).Enabled = True
                Next
                    cmd(2).Caption = "&Save"
        Else
                
               ' On Error GoTo a11:
                
                
                For i = 1 To Text1.Count - 1
                    Text1(i).Enabled = False
                Next
                cust_rs.Open "select * from Customer_master where cutomer_id='" & Text1(0).Text & "'", db, adOpenDynamic, adLockOptimistic
                For i = 1 To Text1.Count - 1
                    If Len(Text1(i).Text) > 0 Then
                        cust_rs.Fields(i).Value = Text1(i).Text
                    End If
                Next
                
                cust_rs.Update
                
                cmd(0).Enabled = True
                cmd(1).Enabled = True
                Combo1.Enabled = True
                db.Execute "UPDATE AMT_UNPAID_REMIND SET PARTY_NAME='" & Text1(1).Text & "' WHERE PARTY_NAME='" & Combo1.Text & "' AND TRAN_TYPE='SALES'"
                LaVolpeButton1.Enabled = True
                cust_rs.Close
                cust_rs.Open "SELECT * FROM Customer_master", db, adOpenDynamic, adLockOptimistic

                Combo1.Clear
                cust_rs.Requery
                
                While cust_rs.EOF <> True
                        Combo1.AddItem cust_rs.Fields(1).Value
                        cust_rs.MoveNext
                Wend
                
                Combo1.Text = Text1(1).Text
                cmd(2).Caption = "&Modify"
                
                SendKeys "{TAB}"
                SendKeys "{TAB}"
                SendKeys "{TAB}"
                SendKeys "{TAB}"
                SendKeys "{TAB}"

                Exit Sub
a11:
                cust_rs.CancelUpdate
                
                MsgBox "Duplicate Customer Name OR NULL Entry Not Allowed ...", vbInformation
                


                 

        End If
        
ElseIf Index = 1 Then
    With CrystalReport2
            .DataFiles(0) = App.Path & "\Master_Database.MDB"
            .ReportFileName = App.Path & "\Report\rpt_salesbook.rpt"
            .SelectionFormula = "{Sales_master.Party_name} = '" & Combo1.Text & "'"
            .username = "Admin"
            .Password = "1010101010" & Chr(10) & "1010101010"
            .Action = 1
            .PageZoom (100)
    End With
End If
End Sub

Private Sub Combo1_Click()
For i = 0 To Text1.Count - 1
    Text1(i).Text = Clear
Next


If Len(Combo1.Text) > 0 Then
    For i = 0 To cmd.Count - 1
        cmd(i).Enabled = True
    Next
    Dim R As New ADODB.Recordset
    R.Open "select * from Customer_master where cutomer_name='" & Combo1.Text & "'", db, adOpenDynamic, adLockOptimistic
    For i = 0 To Text1.Count - 1
        If Len(R.Fields(i).Value) > 0 Then
            Text1(i).Text = R.Fields(i).Value
        End If
    Next
    R.Close
End If
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = 114 Then
    If cmd(0).Enabled = True Then
        Call cmd_Click(0)
    End If
ElseIf KeyCode = 27 Then
    If cmd(2).Enabled = False And Len(Combo1.Text) = 0 Then
        Unload Me
        Exit Sub
    End If
    
    If cmd(0).Enabled = True Then
        Unload Me
    End If
ElseIf KeyCode = 113 Then
        If cmd(0).Enabled = True Then
            Call cmd_Click(1)
        End If

End If
End Sub

Private Sub Form_Load()
Me.Left = 0
Me.Top = 0
KeyPreview = True

For i = 0 To cmd.Count - 1
    cmd(i).Enabled = False
Next



cust_rs.Open "SELECT * FROM Customer_master", db, adOpenDynamic, adLockOptimistic
C_COUNT.Open "SELECT COUNT(*) FROM Customer_master", db, adOpenDynamic, adLockOptimistic
If C_COUNT.Fields(0).Value = 0 Then
    MsgBox "No Customer Record Found ...", vbInformation, "No Customer entry Found ..."
    Unload Me
    Exit Sub
End If

While cust_rs.EOF <> True
    Combo1.AddItem cust_rs.Fields(1).Value
    cust_rs.MoveNext
Wend

For i = 0 To Text1.Count - 1
    Text1(i).Enabled = False
Next


End Sub

Private Sub Form_Unload(Cancel As Integer)
cust_rs.Close
C_COUNT.Close
On Error Resume Next
add_cust_rs.CancelUpdate
cust_no.Close
        'Dim f As New FileSystemObject
        'f.CopyFile App.Path & "\Master_Database.mdb", App.Path & "\data\" & cur_company_name & "\Master_Database.mdb", True
       
End Sub

Private Sub LaVolpeButton1_Click()

If LaVolpeButton1.Caption = "&Add New" Then
                
                LaVolpeButton2.Visible = True
                
                cust_no.Open "select * from SORTED_CUST_NO", db, adOpenDynamic, adLockOptimistic
                
                If add_cust_rs.State = adStateOpen Then
                    add_cust_rs.Close
                End If
                
                add_cust_rs.Open "select * from Customer_master", db, adOpenKeyset, adLockOptimistic
                
                add_cust_rs.AddNew
                If cust_no.EOF <> True Then
                
                    cust_no.MoveLast
                    Dim LAST_ID As String
                    LAST_ID = Mid(cust_no.Fields(0).Value, 2, Len(cust_no.Fields(0).Value))
                    LAST_ID = VAL(LAST_ID) + 1
                    
                    If Len(LAST_ID) = 1 Then
                        Text1(0).Text = "C00000000" & LAST_ID
                    ElseIf Len(LAST_ID) = 2 Then
                        Text1(0).Text = "C0000000" & LAST_ID
                    ElseIf Len(LAST_ID) = 3 Then
                        Text1(0).Text = "C000000" & LAST_ID
                    ElseIf Len(LAST_ID) = 4 Then
                        Text1(0).Text = "C00000" & LAST_ID
                    ElseIf Len(LAST_ID) = 5 Then
                        Text1(0).Text = "C0000" & LAST_ID
                    ElseIf Len(LAST_ID) = 6 Then
                        Text1(0).Text = "C000" & LAST_ID
                    ElseIf Len(LAST_ID) = 7 Then
                        Text1(0).Text = "C00" & LAST_ID
                    ElseIf Len(LAST_ID) = 8 Then
                        Text1(0).Text = "C0" & LAST_ID
                    ElseIf Len(LAST_ID) = 9 Then
                        Text1(0).Text = "C" & LAST_ID
                    End If
                Else
                    Text1(0).Text = "C000000001"
                    
                End If
                
                cust_no.Close
                Combo1.Clear
                Combo1.Enabled = False
                
                For i = 1 To Text1.Count - 1
                    Text1(i).Text = Clear
                    Text1(i).Enabled = True
                Next
                
                LaVolpeButton1.Caption = "&Save"
                cmd(2).Enabled = False
                cmd(1).Enabled = False
                cmd(0).Enabled = False
                SendKeys "{TAB}"
                SendKeys "{TAB}"
                
Else
                
                
                
                
                
                
                
                For i = 0 To Text1.Count - 1
                            If Len(Text1(i).Text) > 0 Then
                                add_cust_rs.Fields(i).Value = Text1(i).Text
                            End If
                
                Next
                
                On Error GoTo A1:
                add_cust_rs.Update
                add_cust_rs.Close
                GoTo a2:
A1:
                MsgBox "Duplicate Customer Name OR NULL Entry Not Allowed ...", vbInformation
                SendKeys "{TAB}"
                SendKeys "{TAB}"
                Exit Sub
                
a2:
                
                
                cmd(0).Enabled = True
                cmd(1).Enabled = True
                cmd(2).Enabled = True
                LaVolpeButton1.Caption = "&Add New"
                

                
                
                
                
                LaVolpeButton2.Enabled = False
                
                
                cust_rs.Requery
                While cust_rs.EOF <> True
                    Combo1.AddItem cust_rs.Fields(1).Value
                    cust_rs.MoveNext
                Wend
                
                Combo1.Text = Text1(1).Text
                Combo1.Enabled = True
                
                For i = 0 To Text1.Count - 1
                        Text1(i).Enabled = False
                Next
                MsgBox "Customer Added Successfully ...", vbInformation
                SendKeys "{TAB}"
                
                
End If










End Sub

Private Sub LaVolpeButton2_Click()

add_cust_rs.CancelUpdate
add_cust_rs.Close
Combo1.Clear
For i = 0 To Text1.Count - 1
     Text1(i).Text = Clear
     Text1(i).Enabled = False
Next

    cmd(0).Enabled = True
    cmd(1).Enabled = True
    cmd(2).Enabled = True
    LaVolpeButton1.Caption = "&Add New"
    LaVolpeButton2.Visible = False
    Combo1.Enabled = True
    cust_rs.Requery
                While cust_rs.EOF <> True
                    Combo1.AddItem cust_rs.Fields(1).Value
                    cust_rs.MoveNext
                Wend
                
    SendKeys "{TAB}"
    SendKeys "{TAB}"
    SendKeys "{TAB}"
    SendKeys "{TAB}"
    SendKeys "{TAB}"
    
    

End Sub

Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
    KeyCode = 0
    SendKeys "{TAB}"
End If
End Sub
123

frm_search_record.frm - 源码说明

本页面展示了「很好一套库存管理」中的 frm_search_record.frm 源码文件，采用 FRM 编程语言编写，共 1,200 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫开发者社区收录了大量与库存管理相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

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