📄 form3.frm
字号:
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 1440
TabIndex = 35
Top = 120
Width = 1455
End
Begin VB.Label Label7
BackStyle = 0 'Transparent
Caption = "Location"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 1440
TabIndex = 34
Top = 3000
Width = 1455
End
Begin VB.Label Label6
BackStyle = 0 'Transparent
Caption = "Op. Balance"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 1440
TabIndex = 33
Top = 2520
Width = 1455
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "Price"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 1440
TabIndex = 32
Top = 2040
Width = 1455
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "Group Head"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 1455
TabIndex = 31
Top = 600
Width = 1455
End
Begin VB.Label Label8
BackStyle = 0 'Transparent
Caption = "Manufecturer"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 1440
TabIndex = 30
Top = 3480
Width = 1455
End
Begin VB.Label Label14
BackStyle = 0 'Transparent
Caption = "Item Name"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 1440
TabIndex = 29
Top = 1080
Width = 1455
End
Begin VB.Label Label15
BackStyle = 0 'Transparent
Caption = "Make && Model"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 255
Left = 1440
TabIndex = 28
Top = 1560
Width = 1455
End
End
Attribute VB_Name = "Stock"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim e As Integer
Private Sub Check1_Click()
If Check1.Value = 1 Then
Text9.Enabled = True
Text10.Enabled = True
Else
Text9.Enabled = False
Text10.Enabled = False
End If
End Sub
Private Sub Combo1_Click()
Text2 = Combo1.Text
End Sub
Private Sub Combo2_Click()
Text3 = Combo2.Text
Combo3.Clear
data3.RecordSource = "select distinct item from stock where g_head like '" + Trim(Combo2.Text) + "%'"
data3.Refresh
While data3.Recordset.EOF = False
Combo3.AddItem data3.Recordset.Fields(0)
data3.Recordset.MoveNext
Wend
End Sub
Private Sub Combo3_Click()
Combo4.Clear
Text4 = Combo3.Text
data3.RecordSource = "select distinct model from stock where g_head = '" + Text3 + "' and item = '" + Text4 + "'"
data3.Refresh
While data3.Recordset.EOF = False
Combo4.AddItem data3.Recordset.Fields(0)
data3.Recordset.MoveNext
Wend
End Sub
Private Sub Combo4_Click()
Text5 = Combo4.Text
End Sub
Private Sub Command1_Click()
data1.Recordset.MoveFirst
End Sub
Private Sub Command10_Click()
r = MsgBox("Wish to Insert Another Item?", vbYesNo, "Insert New...")
data1.Recordset.CancelUpdate
If r = vbYes Then
Call Form_Activate
Else
MAIN.Enabled = True
MAIN.Show
Unload Me
End If
End Sub
Private Sub Command11_Click()
End Sub
Private Sub Command2_Click()
data1.Recordset.MovePrevious
If data1.Recordset.BOF = True Then
data1.Recordset.MoveFirst
End If
End Sub
Private Sub Command3_Click()
data1.Recordset.MoveNext
If data1.Recordset.EOF = True And data1.Recordset.BOF = False Then
data1.Recordset.MoveLast
End If
End Sub
Private Sub Command4_Click()
data1.Recordset.MoveLast
End Sub
Private Sub Command5_Click()
On Error Resume Next
data1.Recordset.AddNew
Frame3.Enabled = True
Frame1.Visible = False
Frame2.Visible = True
Combo2.Visible = True
Combo3.Visible = True
Combo4.Visible = True
Text8 = "1"
Text12 = "STORE ROOM"
'
If data3.Recordset.RecordCount <> 0 Then
data3.Recordset.MoveFirst
data3.RecordSource = "select distinct g_head from stock"
data3.Refresh
Combo2.Clear
While data3.Recordset.EOF = False
Combo2.AddItem data3.Recordset.Fields(0)
data3.Recordset.MoveNext
Wend
End If
'
End Sub
Private Sub Command6_Click()
e = 1
Frame3.Enabled = True
Frame1.Visible = False
Frame2.Visible = True
End Sub
Private Sub Command7_Click()
Dim a As Integer
a = MsgBox("Wish to Delete This Rec. Parmanently ", vbYesNo)
If a = vbYes Then
data1.Recordset.Delete
Call Command3_Click
End If
End Sub
Private Sub Command8_Click()
Dim a As String
a = InputBox("Enter Item Code")
s = "Item_code = '" + a + "'"
data1.Recordset.MoveFirst
data1.Recordset.Find s
If data1.Recordset.EOF = True Then
MsgBox "Record Does not exists"
data1.Recordset.MoveFirst
End If
End Sub
Private Sub Command9_Click()
Dim q As String
Dim r As Integer
If e = 0 Then
'change the code for dup. as form1
q = "select * from stock where g_head = '" + Text3 + "' and item = '" + Text4 + "' and model = '" + Text5 + "'"
data3.RecordSource = q
data3.Refresh
If data3.Recordset.RecordCount = 0 Then
' validations
If Trim(Text6) = "0" Or Trim(Text6) = "" Then
MsgBox "You cant Leave Price Field empty."
Text6.SetFocus
Exit Sub
End If
If Val(Text6) > Val(Text7) Then
MsgBox "MRP cant be less than the cost price."
Text6.SetFocus
Exit Sub
End If
If Trim(Text1) = "" Then
MsgBox "Item-Code can not be Blank."
Text1.SetFocus
Exit Sub
End If
If Trim(Text3) = "" Or Trim(Text4) = "" Or Trim(Text5) = "" Then
MsgBox "Values can not be blank"
Exit Sub
End If
'end validations
'auto insertion
'data2.Recordset.MoveFirst
'data2.Recordset.Fields(1).Value = data2.Recordset.Fields(1).Value + 1
'Text1 = "CON-" + Str(data2.Recordset.Fields(1).Value)
'end insertion
data1.Recordset.Fields("iss_qty") = "0"
data1.Recordset.Fields("QOH") = Val(Text8)
data1.Recordset.Update
data1.Recordset.MoveLast
Else
MsgBox "This Product already exists in the database. Select Different..."
Text3.SetFocus
Exit Sub
End If
Else
data1.Recordset.Update
e = 0
End If
Frame2.Visible = False
Frame1.Visible = True
Frame3.Enabled = False
'Combo1.Visible = False
Combo2.Visible = False
Combo3.Visible = False
Combo3.Visible = False
r = MsgBox("Wish to Insert Another Item?", vbYesNo, "Insert New...")
If r = vbYes Then
Call Command5_Click
Else
MAIN.Enabled = True
MAIN.Show
Unload Me
End If
End Sub
Private Sub Form_Activate()
Dim res As Integer
If data1.Recordset.RecordCount = 0 Then
res = MsgBox("No Record Exists. Whether to insert New Record First?", vbQuestion + vbYesNo, "Please Confirm...")
If res = vbYes Then
Call Command5_Click
Exit Sub
Else
Call Command11_Click
Exit Sub
End If
End If
Call Command5_Click
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii >= 97 And KeyAscii <= 122 Then
KeyAscii = KeyAscii - 32
End If
End Sub
Private Sub Text1_Validate(Cancel As Boolean)
data2.RecordSource = "select * from stock where item_code = '" + Text1 + "'"
data2.Refresh
If data2.Recordset.RecordCount >= 1 Then
MsgBox "This Item Code already Exists. Retype"
Cancel = True
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii >= 97 And KeyAscii <= 122 Then
KeyAscii = KeyAscii - 32
End If
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii >= 97 And KeyAscii <= 122 Then
KeyAscii = KeyAscii - 32
End If
End Sub
Private Sub Text5_KeyPress(KeyAscii As Integer)
If KeyAscii >= 97 And KeyAscii <= 122 Then
KeyAscii = KeyAscii - 32
End If
End Sub
Private Sub Text12_KeyPress(KeyAscii As Integer)
If KeyAscii >= 97 And KeyAscii <= 122 Then
KeyAscii = KeyAscii - 32
End If
End Sub
Private Sub Text13_KeyPress(KeyAscii As Integer)
If KeyAscii >= 97 And KeyAscii <= 122 Then
KeyAscii = KeyAscii - 32
End If
End Sub
Private Sub Text6_KeyPress(KeyAscii As Integer)
If KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 46 Then
KeyAscii = KeyAscii
Else
KeyAscii = 0
Beep
End If
End Sub
Private Sub Text7_KeyPress(KeyAscii As Integer)
If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 46 Then
KeyAscii = KeyAscii
Else
KeyAscii = 0
Beep
End If
End Sub
Private Sub Text8_KeyPress(KeyAscii As Integer)
If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 46 Then
KeyAscii = KeyAscii
Else
KeyAscii = 0
Beep
End If
End Sub
Private Sub Text9_KeyPress(KeyAscii As Integer)
If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 46 Then
KeyAscii = KeyAscii
Else
KeyAscii = 0
Beep
End If
End Sub
Private Sub Text10_KeyPress(KeyAscii As Integer)
If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 46 Then
KeyAscii = KeyAscii
Else
KeyAscii = 0
Beep
End If
End Sub
Private Sub Text11_KeyPress(KeyAscii As Integer)
If (KeyAscii >= 48 And KeyAscii <= 57) Or KeyAscii = 46 Then
KeyAscii = KeyAscii
Else
KeyAscii = 0
Beep
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -