sc_bom_rpt.frm

基于SQL2000的企业管理MRPII,包含进销存,财务,报关等组件,VB6开发,带文档说明.

      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   ""
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   "Ado_CpXX"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin VB.Label Label 
      Caption         =   "产品查询"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   11.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Index           =   22
      Left            =   60
      TabIndex        =   13
      Top             =   7425
      Width           =   1065
   End
End
Attribute VB_Name = "SC_BoM_RpT"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim khdk As Adodb.Recordset
Dim Dr_RE As Recordset
Dim zztz_rpt As Adodb.Recordset
Dim Tjbz As Boolean

Private Sub CMD_Dr_Click()
Set Dr_RE = New Recordset
Dr_RE.Open "select * from yy_bzdj_B where cpbh_s not in(select distinct cpbh_s from sc_bom_H)", DB, adOpenStatic, adLockReadOnly
If Dr_RE.RecordCount > 0 Then
   Dr_RE.MoveFirst
   For i = 1 To Dr_RE.RecordCount
   AdoprimaryRs.Recordset.ActiveConnection.Execute "insert into sc_bom_H(cpbh_s,cplb,cpbh,cpmc,gg,yanse,caizh,dw,bacp) values('" & Dr_RE.Fields("cpbh_s").Value & "', '" & Dr_RE.Fields("cplb").Value & "','" & Dr_RE.Fields("cpbh").Value & "','" & Dr_RE.Fields("cpmc").Value & "','" & Dr_RE.Fields("gg").Value & "','" & Dr_RE.Fields("yanse").Value & "','" & Dr_RE.Fields("caizh").Value & "','" & Dr_RE.Fields("dw").Value & "','" & Dr_RE.Fields("bacp").Value & "')"
   Dr_RE.MoveNext
   Next i
End If
AdoprimaryRs.Recordset.Requery
End Sub

Private Sub CMd_WlDr_Click()
If Ado_Body.Recordset.RecordCount <= 0 And Cmdadd.Enabled = False And Trim(Text2.Text) <> "" And Trim(Text(0).Text) <> "" Then
Set Dr_RE = New Recordset
Dr_RE.Open "select * from sc_bom_B where cpbh_s='" & Trim(Text2.Text) & "'", DB, adOpenStatic, adLockReadOnly
If Dr_RE.RecordCount > 0 Then
   Dr_RE.MoveFirst
   For i = 1 To Dr_RE.RecordCount
   Ado_Body.Recordset.ActiveConnection.Execute "insert into sc_bom_b(ylbh,ylmc,gg,yanse,caizh,dw,shl,dsh,cpbh_s,cpmc,bacp,bacp_M,yl_cplb) values('" & Dr_RE.Fields("ylbh").Value & "', '" & Dr_RE.Fields("ylmc").Value & "','" & Dr_RE.Fields("gg").Value & "','" & Dr_RE.Fields("yanse").Value & "','" & Dr_RE.Fields("caizh").Value & "','" & Dr_RE.Fields("dw").Value & "','" & Dr_RE.Fields("shl").Value & "','" & Dr_RE.Fields("dsh").Value & "','" & Trim(Text(0).Text) & "','" & Trim(Text(2).Text) & "','" & Dr_RE.Fields("bacp").Value & "','" & Trim(Text(1).Text) & "','" & Dr_RE.Fields("yl_cplb").Value & "')"
   Dr_RE.MoveNext
   Next i
End If
End If
Ado_Body.Recordset.Requery
End Sub

'*******************************************************
'*            曹汉华   2004.5.26  编写  晚              *
'*******************************************************
Private Sub cmdnext_Click() '向后

  On Error GoTo GoNextError
  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
GoNextError:
  MsgBox Err.Description
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()
  Tjbz = False
  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 Command1_Click()

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) '非法退出禁止
If Cmdcancel.Enabled = True Then
If UnloadMode <> VBRUN.QueryUnloadConstants.vbFormCode Then
Cancel = 1
Exit Sub
End If
End If
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
 AdoprimaryRs.ConnectionString = Conn_Str
 AdoprimaryRs.RecordSource = "select * from sc_Bom_H order by cpbh_s,cpmc,gg"
 AdoprimaryRs.Refresh
End Sub

Private Sub Cmdadd_Click()
  Tjbz = True
  Text1.Enabled = False
  cmdqd.Enabled = False
  cmdxq.Enabled = False
  cmdnext.Enabled = False
  cmdmd.Enabled = False
  CMD_Dr.Enabled = False
  TDBGrid3.Enabled = False
  Cmddelete.Enabled = False
  Cmdadd.Enabled = False
  Cmdedit.Enabled = False
  Cmdreturn.Enabled = False
  CmdOK.Enabled = True
  Cmdcancel.Enabled = True
  TDBGrid1.AllowAddNew = True
  TDBGrid1.AllowDelete = True
  TDBGrid1.AllowUpdate = True
On Error GoTo AddErr
  If AdoprimaryRs.Recordset.RecordCount > 0 Then
     AdoprimaryRs.Recordset.MoveLast
  End If
  AdoprimaryRs.Recordset.AddNew
  Exit Sub
AddErr:
  MsgBox Err.Description
End Sub

Private Sub cmdDelete_Click() '删除
  On Error Resume Next
   If MsgBox("是否真的删除当前记录 ？", vbYesNo + 32, "系统提示") = vbYes Then
  Ddcode = Trim(Text(0).Text)
  Ado_Body.Recordset.ActiveConnection.Execute "delete from sc_Bom_B where cpbh_S='" & Ddcode & "'"
  Ado_Body.Recordset.UpdateBatch adAffectAll
  If AdoprimaryRs.Recordset.RecordCount > 0 Then
  With AdoprimaryRs
    .Recordset.Delete
    If .Recordset.EOF = False Then .Refresh
      If AdoprimaryRs.Recordset.RecordCount > 0 Then
     .Recordset.MoveLast
      End If
    End With
  End If
  AdoprimaryRs.Refresh
  Ado_Body.Refresh
  Else
  Exit Sub
  End If
End Sub
Private Sub cmdEdit_Click() '修改
  CMd_WlDr.Enabled = True
  Text1.Enabled = False
  cmdqd.Enabled = False
  cmdxq.Enabled = False
  cmdnext.Enabled = False
  cmdmd.Enabled = False
  CMD_Dr.Enabled = False
  TDBGrid3.Enabled = False
  Cmddelete.Enabled = False
  Cmdadd.Enabled = False
  Cmdedit.Enabled = False
  Cmdreturn.Enabled = False
  CmdOK.Enabled = True
  Cmdcancel.Enabled = True
  TDBGrid1.AllowAddNew = True
  TDBGrid1.AllowDelete = True
  TDBGrid1.AllowUpdate = True
  On Error GoTo EditErr
  Exit Sub
EditErr:
  MsgBox Err.Description
End Sub
Private Sub cmdCancel_Click() '取消
  TDBGrid1.AllowDelete = False
  TDBGrid1.AllowUpdate = False
  TDBGrid1.AllowAddNew = False
  CMd_WlDr.Enabled = False
  Text1.Enabled = True
  cmdqd.Enabled = True
  cmdxq.Enabled = True
  cmdnext.Enabled = True
  cmdmd.Enabled = True
  CMD_Dr.Enabled = True
  TDBGrid3.Enabled = True
  Cmddelete.Enabled = True
  Cmdadd.Enabled = True
  Cmdedit.Enabled = True
  Cmdreturn.Enabled = True
  CmdOK.Enabled = False
  Cmdcancel.Enabled = False
  TDBGrid2.Visible = False
  On Error Resume Next
  AdoprimaryRs.Recordset.CancelUpdate
  AdoprimaryRs.Recordset.MoveFirst
End Sub

Private Sub cmdOK_Click()    '确认
  On Error Resume Next
  Tjbz = False
  Frame4.Visible = False
  TDBGrid1.AllowDelete = False
  TDBGrid1.AllowUpdate = False
  TDBGrid1.AllowAddNew = False
   CMd_WlDr.Enabled = False
  If Text(0).Text = "" Then
   MsgBox "所有名称不能为空", 48, "提示"
   Text(0).SetFocus
   Exit Sub
  End If
  If Text(5).Text = "" Then
   Text(5).Text = " "
  End If
  For i = 0 To Text.Count - 1
      Text(i).Locked = True
  Next i
  For i = 0 To Combo.Count - 1
      Combo(i).Locked = True
  Next i
  Text(0).SetFocus
  TDBGrid2.Visible = False
  Text1.Enabled = True
  cmdqd.Enabled = True
  cmdxq.Enabled = True
  cmdnext.Enabled = True
  cmdmd.Enabled = True
  CMD_Dr.Enabled = True
  TDBGrid3.Enabled = True
  Cmddelete.Enabled = True
  Cmdadd.Enabled = True
  Cmdedit.Enabled = True
  Cmdreturn.Enabled = True
  CmdOK.Enabled = False
  Cmdcancel.Enabled = False
  AdoprimaryRs.Recordset.UpdateBatch adAffectAll
  Ado_Body.Recordset.UpdateBatch adAffectAll
  Cmdcancel.Enabled = False
  CmdOK.Enabled = False
  If AdoprimaryRs.Recordset.BOF Then
     AdoprimaryRs.Recordset.MovePrevious
     AdoprimaryRs.Recordset.MoveNext
     Else
     AdoprimaryRs.Recordset.MoveNext
     AdoprimaryRs.Recordset.MovePrevious
  End If
   If Ado_Body.Recordset.RecordCount > 0 Then
     Ado_Body.Recordset.MoveFirst
     With Ado_Body.Recordset
        For i = 1 To .RecordCount
         .Fields("xh").Value = Trim(Str(i))
         If IsNull(.Fields("yycc").Value) = True Then
         .Fields("yycc").Value = " "
         End If
         .MoveNext
        Next i
     End With
  End If
  Exit Sub
UpdateErr:
  MsgBox Err.Description
End Sub
Private Sub TDBGrid1_KeyDown(KeyCode As Integer, Shift As Integer) '表格记录删除 2004年5月26日 曹汉华
If Cmdadd.Enabled = False Then
   If KeyCode = 46 Then
   Ado_Body.Recordset.Delete
   Ado_Body.Recordset.UpdateBatch adAffectAll
   Ado_Body.Refresh
   End If
End If
End Sub
Private Sub TDBGrid1_Change()
If TDBGrid1.Col = 0 And Cmdadd.Enabled = False Then
TDBGrid2.Visible = True
Ado_cpxx.ConnectionString = Conn_Str
Ado_cpxx.RecordSource = "select distinct * from sys_ylmc_b where cpbh_s like '%" & TDBGrid1.Columns(0).Text & "%' and cp_lb='生产物料' order by cpbh_s,cpmc,gg"
Ado_cpxx.Refresh
End If
End Sub

Private Sub TDBGrid2_Click()
On Error Resume Next
TDBGrid1.Columns(0).Value = TDBGrid2.Columns(0).Value
TDBGrid1.Columns(2).Value = TDBGrid2.Columns(1).Value
TDBGrid1.Columns(3).Value = TDBGrid2.Columns(2).Value
TDBGrid1.Columns(4).Value = TDBGrid2.Columns(3).Value
TDBGrid1.Columns(5).Value = TDBGrid2.Columns(4).Value
TDBGrid1.Columns(6).Value = TDBGrid2.Columns(5).Value
TDBGrid1.Columns(7).Value = Trim(Text(2).Text)
TDBGrid1.Columns(10).Value = Trim(Text(0).Text)
TDBGrid1.Columns(11).Value = TDBGrid2.Columns(7).Value
TDBGrid1.Columns(12).Value = Trim(Text(1).Text)
TDBGrid1.Columns(13).Value = TDBGrid2.Columns(6).Value
Ado_Body.Recordset.Fields("xh").Value = Str(TDBGrid1.Row + 1)
End Sub

Private Sub Text_Change(Index As Integer)
  If Index = 0 Then
     Ado_Body.ConnectionString = Conn_Str
     Ado_Body.RecordSource = "select * from sc_bom_b where cpbh_s='" & Text(0).Text & "'"
     Ado_Body.Refresh
  End If
End Sub

Private Sub Text1_Change()
AdoprimaryRs.ConnectionString = Conn_Str
AdoprimaryRs.RecordSource = "select * FROM sc_bom_H where cpbh_s like '%" & Trim(Text1.Text) & "%' order by cpbh_s,CPMC"
AdoprimaryRs.Refresh
End Sub