'**********************************************************************************************************************************************************
'* 模 块 名 称 : 订单信息-生产计划表(表:ddxx_Main; ddxx_Sub;ddxx_Mlxx;ddxx_Flxx;ddxx_Bwcm;ddxx_Bzxx)
'* 描 述 : 通过表:Xt_Grid 中的 Grid_Code 作为标识来操作。首先在表Xt_Grid中添加要操作的字段,并与VSFGrid中的列对应,
'* 说 明: gridcol_fieldlx(1、字符型;2、数值型;3、日期型;4、逻辑型(Bit);0、uniqueidentifier型(该字段不保存,主键值,自动生成)
'*
'* 程 序 员 : LMS/2017.10.18
'**********************************************************************************************************************************************************
Option Explicit
'针对VSFlexGrid,复制、粘贴、移除选中行
Private Sub VSFGrid_Sub_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then PopupMenu XT_Main.c_Edit
End Sub
Private Sub VSFGrid_Ml_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then PopupMenu XT_Main.c_Edit1
End Sub
Private Sub Form_Load()
If DataEnv.DataConn.State = 0 Then DataEnv.DataConn.Open Glmk.PconnString
MyVsf.VSFGrid_Header VSFGrid_Main, 1, 1, 21, False: MyVsf.VSFGrid_Header VSFGrid_Sub, 2, 1, 16, False
MyVsf.VSFGrid_Header VSFGrid_Ml, 1, 1, 8, False: MyVsf.VSFGrid_Header VSFGrid_Cm, 1, 1, 4, False
MyVsf.VSFGrid_Header VSFGrid_Bwcm, 1, 1, 3, False: MyVsf.VSFGrid_Header VSFGrid_Fl, 1, 1, 8, False
DTP1.value = Glmk.PXtrq: TYwdh.Width = 1210
With VSFGrid_Main
' .ColHidden(VSFGrid_Main.Cols - 1) = True '----隐藏 PmKey=最后一列
End With
With fpSpread_Bzxx
.LoadFromFile (App.Path & "ExcelModelfrmscjh_main_bzxx1.ss8")
End With
Frame2.Top = -90: Frame2.Left = 30
Glmk.System_Log Me.Caption, 1 '----写日志
End Sub
Private Sub Form_Resize()
On Error Resume Next
VSFGrid_Main.Width = Me.ScaleWidth - 90
With SSTab1
.Height = Me.ScaleHeight - ToolBar1.Height - VSFGrid_Main.Height - 150
.Width = Me.ScaleWidth - 120
End With
With VSFGrid_Sub
.Height = SSTab1.Height - SSTab1.TabHeight - 180
.Width = SSTab1.Width - 180
End With
With VSFGrid_Ml
.Height = VSFGrid_Sub.Height
.Width = VSFGrid_Sub.Width
End With
With VSFGrid_Cm
.Height = VSFGrid_Sub.Height - Frame1.Height - 60
End With
Frame1.Width = VSFGrid_Sub.Width
With VSFGrid_Bwcm
.Height = VSFGrid_Cm.Height
.Width = VSFGrid_Sub.Width - VSFGrid_Cm.Width - 90
End With
With VSFGrid_Fl
.Height = VSFGrid_Sub.Height
.Width = VSFGrid_Sub.Width
End With
With fpSpread_Bzxx
.Height = VSFGrid_Sub.Height
.Width = VSFGrid_Sub.Width
End With
With fpSpread_Scbb
.Height = VSFGrid_Sub.Height
.Width = VSFGrid_Sub.Width
End With
End Sub
Private Sub VSFGrid_Sub_CellChanged(ByVal Row As Long, ByVal Col As Long)
XT_Main.StatusBar1.Panels(2).Text = "总计划数: " + CStr(MdlVsf.VSFG_SumCol(VSFGrid_Sub, 7))
End Sub
'第 列不允许编辑
Private Sub VSFGrid_Main_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
With VSFGrid_Main
If Col = .Cols - 1 Then Cancel = True
End With
End Sub
'第 列不允许编辑
Private Sub VSFGrid_Sub_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
With VSFGrid_Sub
If Col = .Cols - 1 Then Cancel = True
End With
End Sub
'第 列不允许编辑
Private Sub VSFGrid_Ml_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
With VSFGrid_Ml
If Col = .Cols - 1 Then Cancel = True
End With
End Sub
'第 列不允许编辑
Private Sub VSFGrid_Cm_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
With VSFGrid_Cm
If Col = .Cols - 1 Then Cancel = True
End With
End Sub
'第 列不允许编辑
Private Sub VSFGrid_Bwcm_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
With VSFGrid_Bwcm
If Col = .Cols - 1 Then Cancel = True
End With
End Sub
'第 列不允许编辑
Private Sub VSFGrid_Fl_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
With VSFGrid_Fl
If Col = .Cols - 1 Then Cancel = True
End With
End Sub
'装入表内容和主表信息(制单日期)
Private Sub TYwdh_Change()
Me.MousePointer = 11
Dim rst As New ADODB.RecordSet, SQL As String, II As Integer, KK As Integer
DTP1.value = MyNormal.GetFsrq_BySQL("select * from ddxx_Main where ywdh='" + Trim(TYwdh.Text) + "'")
MyVsf.FillVSFGrid VSFGrid_Main, "select * from ddxx_Main where ywdh='" + Trim(TYwdh.Text) + "'", "ddxx_Main" '----订单信息-主表信息(ddxx_Main)
MyVsf.FillVSFGrid VSFGrid_Sub, "select * from ddxx_Sub where ywdh='" + Trim(TYwdh.Text) + "' order by fl_id", "ddxx_sub" '----订单信息-产品信息(ddxx_Sub)
MyVsf.FillVSFGrid VSFGrid_Ml, "select * from ddxx_Mlxx where ywdh='" + Trim(TYwdh.Text) + "' order by fl_id", "ddxx_mlxx" '----订单信息-面料信息(ddxx_Mlxx)
MyVsf.FillVSFGrid VSFGrid_Cm, "select * from ddxx_Cmxx where ywdh='" + Trim(TYwdh.Text) + "' order by sort_id", "ddxx_cmxx" '----订单信息-尺码信息(ddxx_Cmxx)
MyVsf.FillVSFGrid VSFGrid_Fl, "select * from ddxx_Flxx where ywdh='" + Trim(TYwdh.Text) + "' order by fl_id", "ddxx_flxx" '----订单信息-辅料信息(ddxx_Flxx)
VSFGrid_Main.Rows = 2
'----部位尺码+包装信息
'On Error GoTo err_cl
'---- 部位尺码 ----
Call VSFGrid_Bwcm_Header '部位尺码的动态表头部分(根据ddxx_cmxx表中的尺码来决定)
'----装入数据
Dim Bwcm_Arr() As String '----定义一个数组,通过Split分割,取得所要的尺码相对应数据
With VSFGrid_Bwcm
Set rst = Nothing
Set rst = DataEnv.DataConn.Execute("select * from ddxx_Bwcm where ywdh='" + Trim(TYwdh.Text) + "' order by fl_id")
If Not (rst.EOF And rst.BOF) Then
II = .FixedRows
Do While Not rst.EOF
.AddItem ""
.TextMatrix(II, 0) = II '---在这里II= .FixedRows = 1
.TextMatrix(II, 1) = rst("buwei")
If rst("bwcm") <> "" Then
Bwcm_Arr() = Split(rst("bwcm"), ",")
For KK = 0 To UBound(Bwcm_Arr)
.TextMatrix(II, KK + 2) = Bwcm_Arr(KK)
Next KK
End If
.TextMatrix(II, .Cols - 1) = rst("PmKey")
II = II + 1
rst.MoveNext
Loop
End If
End With
'---- 包装信息 ----
Set rst = Nothing
Set rst = DataEnv.DataConn.Execute("select * from ddxx_Bzxx where ywdh='" + Trim(TYwdh.Text) + "'")
If Not (rst.EOF And rst.BOF) Then
With fpSpread_Bzxx
.Row = 1: .Col = 1: .Text = rst("bzff")
.Row = 1: .Col = 2: .Text = rst("maitou")
.Row = 0: .Col = 3: .Text = rst("pic_kst1")
.Row = 0: .Col = 4: .Text = rst("pic_kst2")
.Row = 0: .Col = 5: .Text = rst("pic_kst3")
.Row = 1: .Col = 3: .TypePictPicture = .LoadPicture(rst("pic_kst1"), PictureTypeJPEG)
.Row = 1: .Col = 4: .TypePictPicture = .LoadPicture(rst("pic_kst2"), PictureTypeJPEG)
.Row = 1: .Col = 5: .TypePictPicture = .LoadPicture(rst("pic_kst3"), PictureTypeJPEG)
End With
End If
Set rst = Nothing
Me.MousePointer = 0
Exit Sub
err_cl:
MsgBox Err.Description, vbOKOnly + vbExclamation, "提示"
Me.MousePointer = 0
End Sub
'-------- 保存或增行前先进行判断是否符合保存条件或主表信息必须符合才能增行 --------
Private Function Save_Check() As Boolean
Save_Check = False
If MyNormal.CheckShbz_ByYwdh("ddxx_Main", Trim(TYwdh.Text)) Then Exit Function '----检查业务单是否已审核
If MyNormal.CheckYwdh(TYwdh.Text, Trim(DTP1.value)) = False Then Exit Function
If MyNormal.CheckZdry("ddxx_main", Trim(TYwdh.Text)) = False Then Exit Function '----看计划制单人员是否与现在的保存人员一致
If MyVsf.CheckRow_ByCols(VSFGrid_Main, "1,2,3") = False Then Exit Function '----订单信息主表 前2列(合同号,客户名称)不能为空
Dim rst As New ADODB.RecordSet '----检查该合同号是否已被保存
Set rst = Nothing
Set rst = DataEnv.DataConn.Execute("select * from ddxx_Main where hth='" + Trim(VSFGrid_Main.TextMatrix(1, 1)) + "'")
If Not (rst.EOF And rst.BOF) Then
If Trim(TYwdh.Text) <> Trim(rst("ywdh")) Then
MsgBox "合同号:" + VSFGrid_Main.TextMatrix(1, 1) + ",已做过生产计划,你可以通过查找该合同获取计划进行编辑!", vbOKOnly + vbExclamation, "提示"
Set rst = Nothing
Exit Function
End If
End If
Set rst = Nothing
If MyVsf.CheckRow_ByCols(VSFGrid_Sub, "1,2,3,4") = False Then Exit Function '----订单信息子表(产品信息) 前4列(pm+pf+sh+ys)不能为空
Save_Check = True
End Function
'保存数据
Private Sub Save_sub()
If Save_Check = False Then Exit Sub
MyVsf.SaveVSFGrid_ByYwdhFsrq VSFGrid_Main, "ddxx_main", "ddxx_main", Trim(TYwdh.Text), DTP1.value, False '1、保存到主表(ddxx_Main)
MyVsf.SaveVSFGrid_ByYwdh VSFGrid_Sub, "ddxx_sub", "ddxx_sub", Trim(TYwdh.Text), False '2、保存到子表(ddxx_Sub) 产品信息
MyVsf.SaveVSFGrid_ByYwdh VSFGrid_Ml, "ddxx_mlxx", "ddxx_mlxx", Trim(TYwdh.Text), False '3、保存到表(ddxx_Mlxx) 面料信息
MyVsf.SaveVSFGrid_ByYwdh VSFGrid_Fl, "ddxx_flxx", "ddxx_flxx", Trim(TYwdh.Text), False '4、保存到表(ddxx_Flxx) 辅料信息
MyVsf.SaveVSFGrid_ByYwdh VSFGrid_Cm, "ddxx_cmxx", "ddxx_cmxx", Trim(TYwdh.Text), False '5、保存到表(ddxx_cmxx) 尺码信息
Call Save_Bwcm(False) '6、保存到表(ddxx_Bwcm) 部位尺码
Call Save_Bzxx '7、保存到表(ddxx_Bzxx) 包装信息
MsgBox "数据已成功保存!", vbOKOnly + vbExclamation, "提示"
Glmk.System_Log Me.Caption, 3 '----写日志
End Sub
'6、保存到部位尺码(ddxx_bwcm)
Private Sub Save_Bwcm(Optional ByVal Mess_Bool As Boolean = True)
'On Error GoTo err_cl
With VSFGrid_Bwcm
If .Rows = .FixedRows Then Exit Sub
Dim rst As New ADODB.RecordSet, SQL As String, II As Integer, KK As Integer, Bwcm_Str As String, Str As String
DataEnv.DataConn.BeginTrans
For II = .FixedRows To .Rows - 1
Set rst = Nothing
If Trim(.TextMatrix(II, .Cols - 1)) = "" Then
SQL = "select * from ddxx_bwcm where ywdh='" + Trim(TYwdh.Text) + "' and 1=2"
Else
SQL = "select * from ddxx_bwcm where ywdh='" + Trim(TYwdh.Text) + "' and Pmkey='" + Trim(.TextMatrix(II, .Cols - 1)) + "'" '-----主键值Pmkey"
End If
rst.Open SQL, DataEnv.DataConn, adOpenDynamic, adLockOptimistic
If rst.EOF And rst.BOF Then rst.AddNew
rst("ywdh") = Trim(TYwdh.Text)
rst("fl_id") = IIf(Val(.TextMatrix(II, 0)) = 0, 1, Val(.TextMatrix(II, 0)))
rst("buwei") = Trim(.TextMatrix(II, 1))
If .Cols > 3 Then
For KK = 2 To .Cols - 2 '从第二列至第X列的值,用","连接成为一个总字符串(若需要通过数组拆分)
Str = Trim(.TextMatrix(II, KK))
Bwcm_Str = IIf(KK = 2, Str, Bwcm_Str + "," + Str)
Next KK
End If
rst("bwcm") = Bwcm_Str
rst.Update
Next II
'---- 以最后一列为主键值
Set rst = Nothing
SQL = "select * from ddxx_bwcm where ywdh='" + Trim(TYwdh.Text) + "' order by fl_id"
Set rst = DataEnv.DataConn.Execute(SQL)
rst.MoveFirst: II = .FixedRows
Do While Not rst.EOF
.TextMatrix(II, .Cols - 1) = rst("Pmkey") '唯一标识号
rst.MoveNext
II = II + 1
Loop
End With
DataEnv.DataConn.CommitTrans
Set rst = Nothing
If Mess_Bool Then MsgBox "系统已经成功保存部位信息数据表!", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
err_cl:
DataEnv.DataConn.RollbackTrans
Set rst = Nothing
MsgBox Err.Description, vbOKOnly + vbCritical, "系统提示"
End Sub
'7、保存到包装信息 表(ddxx_Bzxx)
Private Sub Save_Bzxx()
Dim rst As New ADODB.RecordSet, SQL As String
Set rst = Nothing
SQL = "select * from ddxx_Bzxx where ywdh='" + Trim(TYwdh.Text) + "'"
rst.Open SQL, DataEnv.DataConn, adOpenDynamic, adLockOptimistic
If rst.EOF And rst.BOF Then rst.AddNew
rst("ywdh") = Trim(TYwdh.Text)
With fpSpread_Bzxx
.Row = 1: .Col = 1: rst("bzff") = .Text '---- rst("bzff") = Trim(Txt_Bzff.Text)
.Row = 1: .Col = 2: rst("maitou") = .Text '---- rst("maitou") = Trim(Txt_Mt.Text)
'---- rst("pic_filepath") = Trim(Txt_FilePath.Text)
.Row = 0: .Col = 3: rst("pic_kst1") = .Text '---保存的是图片路径,不直接保存图片到数据库
.Row = 0: .Col = 4: rst("pic_kst2") = .Text
.Row = 0: .Col = 5: rst("pic_kst3") = .Text
End With
rst.Update
Set rst = Nothing
End Sub
'---- 新建 ----
Private Sub New_Sub()
TYwdh.Text = MyNormal.GetYwdh(Trim(DTP1.value), "ddxx_Main") '----根据制单日期生成业务单号
With VSFGrid_Main
.TextMatrix(1, 3) = DTP1.value: .TextMatrix(1, 6) = Glmk.Pczym '----成衣交期 ,业务担当
End With
' VSFGrid_Sub.Rows = VSFGrid_Sub.FixedRows: VSFGrid_Ml.Rows = VSFGrid_Ml.FixedRows: VSFGrid_Cm.Rows = VSFGrid_Cm.FixedRows: VSFGrid_Fl.Rows = VSFGrid_Fl.FixedRows '----产品信息,面料信息,尺码信息,辅料信息
End Sub
'---- 增行 ----
Private Sub AddRow_Sub()
If Save_Check = False Then Exit Sub
Select Case SSTab1.Caption
Case "产品信息"
MyVsf.AddRow VSFGrid_Sub, "1,2,3,4,5"
Case "面料信息"
MyVsf.AddRow VSFGrid_Ml
Case "部位尺码"
MyVsf.AddRow VSFGrid_Bwcm
Case "辅料信息"
MyVsf.AddRow VSFGrid_Fl
End Select
End Sub
'---- 删行 ----
Private Sub DeleteRow_Sub()
If Glmk.Pczym <> "system" Then
If MyNormal.CheckZdry("ddxx_Main", Trim(TYwdh.Text)) = False Then Exit Sub
End If
Select Case SSTab1.Caption
Case "产品信息"
With VSFGrid_Sub
If Trim(.TextMatrix(.Row, .Cols - 1)) = "" Then
MyVsf.DeleteSelectRow_ByUnCheck VSFGrid_Sub, "ddxx_Sub"
Else
MyVsf.DeleteSelectRow_ByCheck VSFGrid_Sub, "Jhdd_Scrbb", "ddxx_Sub"
End If
End With
Case "面料信息"
With VSFGrid_Ml
If Trim(.TextMatrix(.Row, .Cols - 1)) = "" Then
MyVsf.DeleteSelectRow_ByUnCheck VSFGrid_Ml, "ddxx_Mlxx"
Else
MyVsf.DeleteSelectRow_ByCheck VSFGrid_Ml, "Jhdd_Scrbb", "ddxx_Mlxx"
End If
End With
Case "部位尺码"
Case "辅料信息"
End Select
Glmk.System_Log Me.Caption, 4 '----写日志
End Sub
'---- 插入行 ----
Private Sub InsertRow_Sub()
Select Case SSTab1.Caption
Case "产品信息"
MyVsf.InsertRow VSFGrid_Sub
Case "面料信息"
MyVsf.InsertRow VSFGrid_Ml
Case "部位尺码"
MyVsf.InsertRow VSFGrid_Bwcm
Case "辅料信息"
MyVsf.InsertRow VSFGrid_Fl
End Select
End Sub
'---- 导出文件->Excel ----
Private Sub FileToExcel_Sub()
Select Case SSTab1.Caption
Case "产品信息"
MyVsf.File_ToExcel CommonDialog1, VSFGrid_Sub, SSTab1.Caption
Case "面料信息"
MyVsf.File_ToExcel CommonDialog1, VSFGrid_Ml, SSTab1.Caption
Case "部位尺码"
MyVsf.File_ToExcel CommonDialog1, VSFGrid_Bwcm, SSTab1.Caption
Case "辅料信息"
MyVsf.File_ToExcel CommonDialog1, VSFGrid_Fl, SSTab1.Caption
End Select
End Sub
Private Sub ToolBar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "new"
Call New_Sub
Case "save"
Call Save_sub
Case "add_row"
Call AddRow_Sub
Case "del_row"
Call DeleteRow_Sub
Case "Insert_row"
Call InsertRow_Sub
Case "find"
FrmScjh_Main_Find.Show 1
Case "out_excel"
Call FileToExcel_Sub
Case "quit"
Unload Me
End Select
End Sub
'----显示部位尺码的动态表头部分(根据ddxx_cmxx表中的尺码来决定)
Private Sub VSFGrid_Bwcm_Header()
Dim Record_Count As Long, II As Integer
Record_Count = MyNormal.TableRecord_Count("select count(*) from ddxx_cmxx where ywdh='" + Trim(TYwdh.Text) + "'")
If Record_Count > 0 Then
Dim rst As New ADODB.RecordSet
With VSFGrid_Bwcm
II = 2: .Cols = 3
.Cols = .Cols + Record_Count
Set rst = Nothing
Set rst = DataEnv.DataConn.Execute("select cm from ddxx_cmxx where ywdh='" + Trim(TYwdh.Text) + "' order by sort_id")
Do While Not rst.EOF
.TextMatrix(0, II) = rst("cm")
.ColWidth(II) = 1000: .ColAlignment(II) = flexAlignCenterCenter
II = II + 1
rst.MoveNext
Loop
.TextMatrix(0, .Cols - 1) = "PmKey"
.ColWidth(.Cols - 1) = 300
End With
End If
Set rst = Nothing
End Sub
'---- 生成尺码信息表 + 保存尺码信息表
Private Sub Cmd_Sccmxx_Click(Index As Integer)
Dim II As Integer, JJ As Integer
Select Case Index
Case 0 '----生成尺码信息表
With VSFGrid_Cm
If VSFGrid_Sub.Rows = VSFGrid_Sub.FixedRows Then Exit Sub
Dim Cm As String, AddItem_Bool As Boolean
.Rows = .FixedRows
For II = VSFGrid_Sub.FixedRows To VSFGrid_Sub.Rows - 1
Cm = Trim(VSFGrid_Sub.TextMatrix(II, 6))
If .Rows = .FixedRows Then
.AddItem ""
.TextMatrix(.Rows - 1, 1) = Cm
Else
AddItem_Bool = True
For JJ = .FixedRows To .Rows - 1
If Trim(.TextMatrix(JJ, 1)) = Cm Then
AddItem_Bool = False
Exit For
End If
Next JJ
If AddItem_Bool Then
.AddItem ""
.TextMatrix(.Rows - 1, 1) = Cm
End If
End If
Next II
MyVsf.SortRow VSFGrid_Cm, 0
MyVsf.SortRow VSFGrid_Cm, 2
End With
Case 1 '----5、保存到表(ddxx_cmxx) 尺码
MyVsf.SaveVSFGrid_ByYwdh VSFGrid_Cm, "ddxx_cmxx", "ddxx_cmxx", Trim(TYwdh.Text), True
Case 2 '----根据ddxx_cmxx表中的尺码来动态生成表头
Call VSFGrid_Bwcm_Header
Case 3 '-----6、保存到表(ddxx_Bwcm) 部位尺码
Call Save_Bwcm
End Select
End Sub
'选择款式图1,2,3
Private Sub fpSpread_Bzxx_ButtonClicked(ByVal Col As Long, ByVal Row As Long, ByVal ButtonDown As Integer)
On Error GoTo err_cl
With CommonDialog1
.CancelError = True
.Filter = "图片文件|*.jpg;*.bmp" '"图片 (*.jpg)|*.jpg|图片 (*.bmp)|*.bmp" '-- |Word 文档(*.doc)|*.doc|纯文本(*.txt)|*.txt|Html 文档(*.Htm)|*.htm"
.ShowOpen
.DialogTitle = "选择要上传的图片文件"
' Txt_FilePath.Text = .FileName
End With
With fpSpread_Bzxx
.Row = 1: .Col = .ActiveCol
.TypePictPicture = .LoadPicture(CommonDialog1.FileName, PictureTypeJPEG)
.Row = 0: .Col = .ActiveCol: .Text = CommonDialog1.FileName
End With
Exit Sub
err_cl:
With fpSpread_Bzxx
.Row = 0: .Col = .ActiveCol: .Text = ""
End With
MsgBox Err.Description, vbOKOnly + vbExclamation, "提示"
End Sub
Private Sub Form_Unload(Cancel As Integer)
DataEnv.DataConn.Execute ("delete from ddxx_Main where len(hth)=0 and zdry='" + Glmk.Pczym + "'")
XT_Main.StatusBar1.Panels(2).Text = ""
' Set Myclsvsf = Nothing
Glmk.System_Log Me.Caption, 2 '----写日志
End Sub
''******************************************************************************
''导入excel文件到VSFGrid
'Private Sub Cmd_Dr_Click()
' MyVsf.File_ToVSFGrid CommonDialog1, VSFGrid_Sub
'End Sub
'
'************************************************ 导入数据 *********************************************************************
Private Sub Cmd_LoadHth_Click()
MyNormal.Fill_Combox Thth_Copy, "select distinct hth from ERP_DataBase.dbo.jhdd_scjhb_Main order by hth desc"
End Sub
Private Sub Cmd_Dr_Click()
Frame2.Visible = True
End Sub
Private Sub Cmd_Close_Click()
Frame2.Visible = False
End Sub
'按选择的合同号传递数据
Private Sub Cmd_Fzht_Click()
If MyNormal.TableRecord_Count("select count(*) from ddxx_Main where hth='" + Trim(Thth_Copy.Text) + "'") <> 0 Then
MsgBox "该合同号在数据库已存在,不需要传递!", vbOKOnly + vbExclamation, "提示"
Exit Sub
End If
Dim rst As New ADODB.RecordSet, rst1 As New ADODB.RecordSet, SQL1 As String
'----、订单数据
If MyNormal.TableRecord_Count("select count(*) from ERP_DataBase.dbo.jhdd_scjhb_Main where hth='" + Trim(Thth_Copy.Text) + "'") = 0 Then
MsgBox "无数据!", vbOKOnly + vbExclamation, "信息提示"
Exit Sub
End If
Dim Row As Long, Xh As Long
Set rst = Nothing
Set rst = DataEnv.DataConn.Execute("select * from ERP_DataBase.dbo.jhdd_V_scjhb where hth='" + Trim(Thth_Copy.Text) + "'")
DTP1.value = rst("fsrq")
TYwdh.Text = MyNormal.GetMystr_Byfgzf(rst("ywdh"), "-", 0) + "-0" + MyNormal.GetMystr_Byfgzf(rst("ywdh"), "-", 1)
With VSFGrid_Main
.Rows = 2: .TextMatrix(1, 1) = Thth_Copy.Text: .TextMatrix(1, 2) = rst("khmc")
.TextMatrix(1, 3) = rst("jhjq_cy"): .TextMatrix(1, 6) = rst("zywdd"): .TextMatrix(1, 9) = rst("memo")
.TextMatrix(1, 11) = rst("zdry"): .TextMatrix(1, 12) = rst("zdrq")
End With
With VSFGrid_Sub
.Rows = .FixedRows: Row = .FixedRows: Xh = 1
Do While Not rst.EOF
.AddItem ""
.TextMatrix(Row, 0) = Xh
.TextMatrix(Row, 1) = rst("pm")
.TextMatrix(Row, 2) = rst("pf")
.TextMatrix(Row, 3) = rst("sh")
.TextMatrix(Row, 4) = rst("ys")
.TextMatrix(Row, 6) = rst("cm")
.TextMatrix(Row, 7) = rst("jhsl") '计划数
rst.MoveNext
Row = Row + 1: Xh = Xh + 1
Loop
End With
'----2、面料数据
Set rst = Nothing
Set rst = DataEnv.DataConn.Execute("select * from ERP_DataBase.dbo.jhdd_mlgy where hth='" + Trim(Thth_Copy.Text) + "' order by mldm")
If Not (rst.EOF And rst.BOF) Then
With VSFGrid_Ml
.Rows = .FixedRows: Row = .FixedRows: Xh = 1
Do While Not rst.EOF
.AddItem ""
.TextMatrix(Row, 0) = Xh
.TextMatrix(Row, 1) = rst("mldm")
.TextMatrix(Row, 2) = rst("mlmc")
.TextMatrix(Row, 3) = rst("mlpb")
.TextMatrix(Row, 4) = rst("kz")
.TextMatrix(Row, 5) = rst("mlsx")
.TextMatrix(Row, 6) = rst("memo")
rst.MoveNext
Row = Row + 1: Xh = Xh + 1
Loop
End With
End If
Set rst = Nothing
End Sub
'***********************************************************************************
''----选择款式图
'Private Sub Cmd_Kst_Click()
'' Dim Ado_Stream As New ADODB.Stream
'' Dim rst As New ADODB.Recordset, sql As String
'
'On Error GoTo err_cl
' With CommonDialog1
' .CancelError = True
'
' .Filter = "图片文件|*.jpg;*.bmp" '"图片 (*.jpg)|*.jpg|图片 (*.bmp)|*.bmp" '-- |Word 文档(*.doc)|*.doc|纯文本(*.txt)|*.txt|Html 文档(*.Htm)|*.htm"
' .ShowOpen
' .DialogTitle = "选择要上传的图片文件"
' Txt_FilePath.Text = .FileName
' End With
'
' Pic_Kst.Picture = LoadPicture(Txt_FilePath.Text)
'
'' '读取文件到内容
'' With Ado_Stream
'' .Type = adTypeBinary '二进制模式
'' .Open
'' .LoadFromFile CommonDialog1.FileName
'' End With
''
'' '打开上传文件的表
'' Set rst = Nothing
'' sql = "select * from ddxx_Bzxx"
'' rst.Open sql, DataEnv.DataConn, adOpenDynamic, adLockOptimistic
'' If rst.EOF And rst.BOF Then rst.AddNew
'' rst("pic_filepath") = Txt_FilePath.Text
'' 'rst("pic_kst") = Ado_Stream.Read
'' rst.Update
'' Set rst = Nothing
'' Set Ado_Stream = Nothing
'' MsgBox "图片文件上传成功!", vbOKOnly + vbInformation, "提示"
' Exit Sub
'
'err_cl:
' MsgBox Err.Description, vbOKOnly + vbExclamation, "提示"
' Pic_Kst.Picture = LoadPicture("")
'
'' Set rst = Nothing
'' Set Ado_Stream = Nothing
' Exit Sub
'End Sub