?? frmcgd.frm
字號:
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 375
Left = 5880
TabIndex = 7
Top = 2640
Width = 1335
End
Begin VB.Label Label7
BackStyle = 0 'Transparent
Caption = "進 價："
BeginProperty Font
Name = "宋體"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 375
Left = 720
TabIndex = 6
Top = 2640
Width = 1335
End
Begin VB.Label Label6
BackStyle = 0 'Transparent
Caption = "產 地："
BeginProperty Font
Name = "宋體"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 375
Left = 5880
TabIndex = 5
Top = 1920
Width = 1335
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Caption = "單 位："
BeginProperty Font
Name = "宋體"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 375
Left = 720
TabIndex = 4
Top = 1920
Width = 1335
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "包 裝："
BeginProperty Font
Name = "宋體"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 375
Left = 5880
TabIndex = 3
Top = 1200
Width = 1335
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "規 格："
BeginProperty Font
Name = "宋體"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 375
Left = 720
TabIndex = 2
Top = 1200
Width = 1335
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "票 號："
BeginProperty Font
Name = "宋體"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 375
Left = 5880
TabIndex = 1
Top = 480
Width = 1335
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "油品名稱："
BeginProperty Font
Name = "宋體"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 375
Left = 720
TabIndex = 0
Top = 480
Width = 1335
End
End
Attribute VB_Name = "frmCGD"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim connstring As String
Private Sub Form_Load()
On Error GoTo myerr '有異常跳轉
adoCGD.CommandType = adCmdText
adoCGD.RecordSource = "select 油品名稱 from PS_Products where 庫存>0"
adoCGD.Refresh
With adoCGD.Recordset
.MoveFirst
Do While Not .EOF '從第一條開始逐條添加到Combo1的子項中
DoEvents
Combo1.AddItem (!油品名稱)
.MoveNext
Loop
End With
adoCGD.RecordSource = "select 用戶 from PS_Users"
adoCGD.Refresh
With adoCGD.Recordset
.MoveFirst
Do While Not .EOF '從第一條開始逐條添加到Combo2的子項中
DoEvents
Combo2.AddItem (!用戶)
.MoveNext
Loop
End With
adoCGD.RecordSource = "select 供應商簡稱 from PS_Suppliers"
adoCGD.Refresh
With adoCGD.Recordset
.MoveFirst
Do While Not .EOF '從第一條開始逐條添加到Combo3的子項中
DoEvents
Combo3.AddItem (!供應商簡稱)
.MoveNext
Loop
End With
adoCGD.RecordSource = "select 票號 from PS_Purchases order by 票號"
adoCGD.Refresh
With adoCGD.Recordset
If .RecordCount > 0 Then '如果已有記錄則在原來的序號上遞增
.MoveLast
If !票號 <> "" Then
Dim lsph As String
lsph = Right(Trim(!票號), 3) + 1
Text3.Text = DateTime.Date$ & "-P-" & Format(lsph, "000")
End If
Else '如果還沒有記錄則序號開始為001
Text3.Text = DateTime.Date$ & "-P-" & "001"
End If
End With
mebDate.Text = DateTime.Date$ '系統當前日期的字符串形式賦值
myerr:
End Sub
Private Sub Form_Unload(Cancel As Integer)
'將主窗體設置為可用，并將其顯示
frmMain.Enabled = True
frmMain.Show
End Sub
Private Sub Picture1_Click()
On Error GoTo err
'首先檢查油品名稱字段。如果為空，則提示不能為空，然后將焦點轉移到Combo1上
If Trim(Combo1.Text) = "" Then
If MsgBox("油品名稱字段是必須要輸入的！", vbExclamation, "提示！") = vbOK Then
Combo1.SetFocus
End If
Else
'檢查數量字段。如果為空，則提示不能為空，然后將焦點轉移到Text8上
If Text8.Text = "" Then
If MsgBox("數量字段是必須要輸入的！", vbExclamation, "提示！") = vbOK Then
Text8.SetFocus
End If
Else
'檢查進價字段。如果為空，則提示不能為空，然后將焦點轉移到Text6上
If Text6.Text = "" Then
If MsgBox("進價字段是必須要輸入的！", vbExclamation, "提示！") Then
Text6.SetFocus
End If
Else
'檢查供應商字段。如果為空，則提示不能為空，然后將焦點轉移到Combo3上
If Trim(Combo3.Text) = "" Then
If MsgBox("供應商字段是必須要輸入的！", _
vbExclamation, "提示！") = vbOK Then
Combo3.SetFocus
End If
Else
'檢查經手人字段。如果為空，則提示不能為空，然后將焦點轉移到Combo2上
If Trim(Combo2.Text) = "" Then
If MsgBox("經手人字段是必須要輸入的！", _
vbExclamation, "提示！") = vbOK Then
Combo2.SetFocus
End If
Else
'輸入檢測無誤后可以提交數據
connstring = "Provider=SQLOLEDB.1;Password=ecc;Persist Security " _
& "Info=True;User ID=sa;Initial Catalog=PetrolStation System;Server=(local)"
If conn.State <> 1 Then '打開數據庫
conn.Open (connstring)
End If
Dim sql As String
sql = "insert into PS_Purchases (油品名稱," & _
"數量,進價,金額,備注,供應商,日期,經手人,票號) " & _
"values ('" & Trim(Combo1.Text) & "'," _
& Trim(Text8.Text) & "," & Trim(Text6.Text) & "," _
& Trim(Text7.Text) & ",'" & Trim(Text9.Text) & "','" & _
Trim(Combo3.Text) & "','" & Trim(mebDate.Text) & _
"','" & Trim(Combo2.Text) & "','" & Trim(Text3.Text) & "')"
conn.Execute (sql) '執行插入操作
conn.Close
'如果沒有發生異常就表明插入操作成功，提示用戶，然后退出本窗口
If MsgBox("采購單成功生成！", vbInformation, "提示") = vbOK Then
Unload Me
End If
End If
End If
End If
End If
End If
err:
End Sub
Private Sub Text6_LostFocus()
On Error GoTo myerr
If Text6.Text <> "" And Text8.Text <> "" Then
' 只有兩個文本框中都輸入了內容時才能計算金額
Text7.Text = Trim(Text6.Text) * Trim(Text8.Text)
End If
Exit Sub
myerr: If MsgBox("價格必須是數值，數量必須是整數！", vbInformation, "提示！") Then GoTo myerr1
myerr1:
End Sub
Private Sub Combo1_lostfocus()
connstring = "Provider=SQLOLEDB.1;Password=ecc;Persist Security Info=True;User ID=sa;" _
& "Initial Catalog=PetrolStation System;Server=(local)"
If conn.State <> 1 Then '連接數據庫
conn.Open (connstring)
End If
Set rs = conn.Execute("select 產地,規格,包裝,單位,庫存 from PS_Products where 油品名稱='" _
& Trim(Combo1.Text) & "'")
With rs
.MoveFirst
Do While Not .EOF '將檢索結果在相應的控件上顯示出來
DoEvents
Text1.Text = !規格
Text4.Text = !包裝
Text2.Text = !單位
Text5.Text = !產地
Text8.Text = !庫存
.MoveNext
Loop
End With
End Sub
Private Sub Text8_LostFocus()
On Error GoTo myerr
If Text6.Text <> "" And Text8.Text <> "" Then
' 只有兩個文本框中都輸入了內容時才能計算金額
Text7.Text = Trim(Text6.Text) * Trim(Text8.Text)
End If
Exit Sub
myerr: If MsgBox("價格必須是數值，數量必須是整數！", vbInformation, "提示！") Then GoTo myerr1
myerr1:
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -