📄 cg_yl_shd.frm
字号:
Begin VB.Label Label1
Caption = "收货部门"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 6
Left = 90
TabIndex = 43
Top = 1530
Width = 1005
End
Begin VB.Label Label1
Caption = "结算方式"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 10
Left = 90
TabIndex = 36
Top = 1080
Width = 1125
End
Begin VB.Label Label1
Caption = "供方编号"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 9
Left = 2700
TabIndex = 35
Top = 270
Width = 1425
End
Begin VB.Label Label1
Caption = "来货单号"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 8
Left = 90
TabIndex = 34
Top = 660
Width = 975
End
Begin VB.Label Label1
Caption = "收货日期"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 3
Left = 5220
TabIndex = 33
Top = 270
Width = 1125
End
Begin VB.Label Label1
Caption = "收货单号"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 0
Left = 90
TabIndex = 32
Top = 270
Width = 1335
End
Begin VB.Label Label1
Caption = "币制"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 1
Left = 3120
TabIndex = 31
Top = 1095
Width = 615
End
Begin VB.Label Label1
Caption = "汇率"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 2
Left = 5670
TabIndex = 30
Top = 1095
Width = 555
End
Begin VB.Label Label1
Caption = "供方名称"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 7
Left = 2700
TabIndex = 29
Top = 660
Width = 1515
End
End
End
Attribute VB_Name = "CG_YL_shd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Tjbz As Boolean
Dim combo2_data, Combo5_Data, Combo6_Data As Recordset
Private Sub CMd_Find_Click()
On Error Resume Next
Set CX_FrM_SjY = CG_YL_shd.AdoprimaryRs
CX_SJy = "select * from cg_SHdt where not SHDbh is null "
With SEC_Dialog
.Combo1(0).Clear
.Combo1(1).Clear
.Combo1(0).AddItem ("gysbh(供方编号）")
.Combo1(1).AddItem ("gysbh(供方编号）")
.Combo1(0).AddItem ("gysmc(供方名称）")
.Combo1(1).AddItem ("gysmc(供方名称）")
.Combo1(0).AddItem ("shdbh(收货单号）")
.Combo1(1).AddItem ("cshdbh(收货单号）")
.Combo1(0).AddItem ("lhdh(来货单号）")
.Combo1(1).AddItem ("lhdh(来货单号）")
.Combo1(0).AddItem ("bmmc(收货部门）")
.Combo1(1).AddItem ("bmmc(收货部门）")
End With
Load SEC_Dialog
SEC_Dialog.Show 1
End Sub
Private Sub CmD_SH_Click()
Dim Sh_Dh As String
Sh_Dh = Text1(0).Text
DB.Execute "update cg_shdt set sh = '已审' where shdbh='" & Text1(0).Text & "'"
AdoprimaryRs.Recordset.Requery
AdoprimaryRs.Recordset.Find ("shdbh='" & Sh_Dh & "'")
End Sub
'*******************************************************
'* 曹汉华 2004.6.24 修改 *
'*******************************************************
Private Sub cmdnext_Click() '向后
If Not AdoprimaryRs.Recordset.EOF Then AdoprimaryRs.Recordset.MoveNext
If AdoprimaryRs.Recordset.EOF And AdoprimaryRs.Recordset.RecordCount > 0 Then
Beep
AdoprimaryRs.Recordset.MoveLast
End If
Exit Sub
End Sub
Private Sub CmdPrint_Click()
Cg_SHd_rPt.HZJe = HZJe(Val(Text1(8).Text))
Cg_SHd_rPt.DataControl1.ConnectionString = Conn_Str
Cg_SHd_rPt.DataControl1.Source = "select cg_shdt.*,cg_shd.* from cg_shd inner join cg_shdt on cg_shd.shdbh=cg_shdt.shdbh where cg_shd.shdbh='" & Text1(0).Text & "'"
Cg_SHd_rPt.Show VBRUN.FormShowConstants.vbModal
End Sub
Private Sub Cmdqd_Click() '首端
If AdoprimaryRs.Recordset.RecordCount > 0 Then
If AdoprimaryRs.BOFAction = False Then
AdoprimaryRs.Recordset.MoveFirst
Else
AdoprimaryRs.Recordset.MoveNext
End If
Else
Exit Sub
End If
End Sub
Private Sub Cmdreturn_Click()
Unload Me
End Sub
Private Sub cmdxq_Click() '向前
On Error GoTo GoPrevError
If Not AdoprimaryRs.Recordset.BOF Then AdoprimaryRs.Recordset.MovePrevious
If AdoprimaryRs.Recordset.BOF And AdoprimaryRs.Recordset.RecordCount > 0 Then
Beep
AdoprimaryRs.Recordset.MoveFirst
End If
Exit Sub
GoPrevError:
MsgBox Err.Description
End Sub
Private Sub cmdmd_Click() '末端
If AdoprimaryRs.Recordset.RecordCount > 0 Then
If AdoprimaryRs.Recordset.EOF = False Then
AdoprimaryRs.Recordset.MoveLast
Else
AdoprimaryRs.Recordset.MovePrevious
End If
Else
Exit Sub
End If
End Sub
Private Sub Combo_Click(Index As Integer)
On Error Resume Next
If Index = 0 And Cmdadd.Enabled = False Then
Dim khdk As Recordset
Set khdk = New Adodb.Recordset
khdk.Open "select * from sys_gyszl where gysbh='" & Combo(0).Text & "'", DB, adOpenStatic, adLockBatchOptimistic
If khdk.RecordCount >= 1 Then
khdk.MoveFirst
AdoprimaryRs.Recordset.Fields("shdz").Value = khdk!dizhi
AdoprimaryRs.Recordset.Fields("gysmc").Value = khdk!gysmc
AdoprimaryRs.Recordset.Fields("fkfs").Value = khdk!fkfs
AdoprimaryRs.Recordset.Fields("bizh").Value = khdk!bizh
AdoprimaryRs.Recordset.Fields("hl").Value = khdk!hl
AdoprimaryRs.Recordset.Fields("phone").Value = khdk!Phone
AdoprimaryRs.Recordset.Fields("fax").Value = khdk!Fax
AdoprimaryRs.Recordset.Fields("zffs").Value = khdk!zffs
End If
End If
End Sub
Private Sub DTPicker1_Change()
If Check1.Value = 0 Then
AdoprimaryRs.ConnectionString = Conn_Str
AdoprimaryRs.RecordSource = "SELECT * FROM cg_shdt WHERE YEAR(djRQ)='" & DTPicker1.Year & "' AND MONTH(djRQ)='" & DTPicker1.Month & "' ORDER BY shdbh"
Else
AdoprimaryRs.ConnectionString = Conn_Str
AdoprimaryRs.RecordSource = "SELECT * FROM cg_shdt WHERE djRQ='" & DTPicker1.Value & "' order BY shdbh"
End If
AdoprimaryRs.Refresh
End Sub
Private Sub Form_Load() '列表框数据
Me.Width = main_FRM.Picture1.Width - 30
Me.Top = main_FRM.ActiveBar21.Bands("Band7").Height * 2.5 - 65
Me.Height = main_FRM.Picture1.Height - 300
Me.Left = main_FRM.Picture1.Left + 15
Tjbz = False
Me.DTPicker1.Value = VBA.Date
Call combo_load
On Error Resume Next
If SH_Right = True Then
CmD_SH.Visible = True
Else
CmD_SH.Visible = False
End If
AdoprimaryRs.ConnectionString = Conn_Str '打开表头
AdoprimaryRs.CommandType = adCmdUnknown
AdoprimaryRs.RecordSource = "select* FROM cg_shdt with(nolock)"
AdoprimaryRs.Refresh
For i = 0 To Text1.Count - 1
Text1(i).Locked = True
Next i
For i = 0 To Combo.Count - 1
Combo(i).Locked = True
Next i
End Sub
Private Sub Form_Unload(Cancel As Integer)
AdoprimaryRs.Recordset.Close
Unload Me
End Sub
Private Sub T_Sh_Change()
If T_Sh.Text = "已审" And SH_Right = False Then
Cmdedit.Visible = False
Cmddelete.Visible = False
Else
Cmdedit.Visible = True
Cmddelete.Visible = True
End If
End Sub
Private Sub T_Sh_GotFocus()
SendKeys "{TAB}"
End Sub
Private Sub TDBGrid1_BeforeColupdate(ByVal ColIndex As Integer, OldValue As Variant, Cancel As Integer)
If ColIndex = 11 Or ColIndex = 7 Or ColIndex = 8 Then
TDBGrid1.Columns(11).Value = Val(TDBGrid1.Columns(8).Value) * Val(TDBGrid1.Columns(7).Value)
Adodc_body_general.Recordset.Fields("zl").Value = Val(TDBGrid1.Columns(8).Value) * Val(TDBGrid1.Columns(21).Value)
End If
End Sub
Private Sub TDBGrid1_AfterColUpdate(ByVal ColIndex As Integer)
If Cmdadd.Enabled = False Then
Dim Sh_Zj As Double
Dim Sh_TJ As Recordset
Set Sh_TJ = New Recordset
Sh_TJ.Open "select sum(isnull(sl,0)) as shsl from cg_shd where shdbh<>'" & Text1(0).Text & "' and cgdbh='" & Trim(TDBGrid1.Columns(1).Text) & "' and ylbh='" & Trim(TDBGrid1.Columns(0).Text) & "' and ylmc='" & Trim(TDBGrid1.Columns(2).Text) & "' and gg='" & Trim(TDBGrid1.Columns(3).Text) & "'AND yanse='" & Trim(TDBGrid1.Columns(5).Text) & "'", DB, adOpenStatic
If Sh_TJ.RecordCount > 0 Then
Sh_TJ.MoveFirst
If Not IsNull(Sh_TJ!shsl) Then
Sh_Zj = Sh_TJ!shsl
Else
Sh_Zj = 0
End If
End If
TDBGrid1.Columns(20).Value = Sh_Zj
If Sh_Zj + Val(TDBGrid1.Columns(8).Text) >= Val(TDBGrid1.Columns(18).Text) Then
MsgBox "此采购订单收货数量已足.超出采购订单量" & Str((Sh_Zj + Val(TDBGrid1.Columns(8).Text)) - Val(TDBGrid1.Columns(18).Text)), 64 + vbOKOnly, "系统提示"
Sh_TJ.ActiveConnection.Execute "UPDATE cg_cgd SET WANCH='完成' where cgdbh='" & Trim(TDBGrid1.Columns(1).Text) & "' and ylbh='" & Trim(TDBGrid1.Columns(0).Text) & "' and ylmc='" & Trim(TDBGrid1.Columns(2).Text) & "' and gg='" & Trim(TDBGrid1.Columns(3).Text) & "'AND yanse='" & Trim(TDBGrid1.Columns(5).Text) & "'"
TDBGrid1.Columns(19).Value = "完成"
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -