📄 frmzjdj.frm

📁 适合于中小型企业管理
💻 FRM
📖 第 1 页 / 共 5 页
字号:
上一页 1 2 3 45
       
    TxtSql = "select Dm_检验表.ID,站机人,擦片人,Dm_检验表.图号,品名,规格,部门名称,送检数,一级品,留用数,站二级,擦二级,站报废,擦报废,返工数,仓库名称1,仓库名称2,仓库名称3,仓库名称4,送检日期,Dm_检验表.创建者 from Dm_检验表 inner join Bs_产品图号 on Dm_检验表.图号=Bs_产品图号.图号 where "

    If Check1(0).Value = 1 Then
        If Cmb1.Text = "领料日期" Or Cmb1.Text = "送检日期" Then
            If Trim(txt01.Text) = "" Or Cmb1.Text = "" Or Like1.Text = "" Then
                MsgBox "搜索条件第1行有空！", vbOKOnly + vbExclamation, "警告"
                Cmb1.SetFocus
                Exit Sub
            Else
                dd(0) = True
                If Like1.Text = "Like" Then
                    MsgBox "日期数据不支持“LIKE”！", vbOKOnly + vbExclamation, "警告"
                    Exit Sub
                Else
                    TxtSql = TxtSql & Cmb1.Text & " " & Like1.Text & " '" & Trim(txt01.Text) & "' "
                End If
            End If
        Else
            If Trim(txt01.Text) = "" Or Cmb1.Text = "" Or Like1.Text = "" Then
                MsgBox "搜索条件第1行有空！", vbOKOnly + vbExclamation, "警告"
                Cmb1.SetFocus
                Exit Sub
            Else
                dd(0) = True
                If Like1.Text = "Like" Then
                    TxtSql = TxtSql & Cmb1.Text & " " & Like1.Text & " '%" & Trim(txt01.Text) & "%' "
                Else
                    TxtSql = TxtSql & Cmb1.Text & " " & Like1.Text & " '" & Trim(txt01.Text) & "' "
                End If
            End If
        End If
    End If
    
    If Check1(1).Value = 1 Then
        If Trim(Txt02.Text) = "" Or Cmb2.Text = "" Or Like2.Text = "" Then
            MsgBox "搜索条件第2行有空", vbOKOnly + vbExclamation, "警告"
            Cmb2.SetFocus
            Exit Sub
        Else
            If Cmb2.Text = "领料日期" Or Cmb2.Text = "送检日期" Then
                dd(1) = True
                If dd(0) = True Then
                    If Like2.Text = "Like" Then
                        MsgBox "日期数据不支持“LIKE”！", vbOKOnly + vbExclamation, "警告"
                        Exit Sub
                    Else
                        TxtSql = TxtSql & " and " & Cmb2.Text & " " & Like2.Text & " '" & Trim(Txt02.Text) & "' "
                    End If
                Else
                    If Like2.Text = "Like" Then
                        MsgBox "日期数据不支持“LIKE”！", vbOKOnly + vbExclamation, "警告"
                        Exit Sub
                    Else
                        TxtSql = TxtSql & Cmb2.Text & " " & Like2.Text & " '" & Trim(Txt02.Text) & "' "
                    End If
                End If
            Else
                dd(1) = True
                If dd(0) = True Then
                    If Like2.Text = "Like" Then
                        TxtSql = TxtSql & " and " & Cmb2.Text & " " & Like2.Text & " '%" & Trim(Txt02.Text) & "%' "
                    Else
                        TxtSql = TxtSql & " and " & Cmb2.Text & " " & Like2.Text & " '" & Trim(Txt02.Text) & "' "
                    End If
                Else
                    If Like2.Text = "Like" Then
                        TxtSql = TxtSql & Cmb2.Text & " " & Like2.Text & " '%" & Trim(Txt02.Text) & "%' "
                    Else
                        TxtSql = TxtSql & Cmb2.Text & " " & Like2.Text & " '" & Trim(Txt02.Text) & "' "
                    End If
                End If
            End If
        End If
    End If
    
    If Check1(2).Value Then
        If Trim(Txt03.Text) = "" Or Cmb3.Text = "" Or Like3.Text = "" Then
            MsgBox "搜索条件第3行有空", vbOKOnly + vbExclamation, "警告"
            Cmb3.SetFocus
            Exit Sub
        Else
            If Cmb3.Text = "领料日期" Or Cmb3.Text = "送检日期" Then
                dd(2) = True
                If dd(0) Or dd(1) Then
                    If Like3.Text = "Like" Then
                        MsgBox "日期数据不支持“LIKE”！", vbOKOnly + vbExclamation, "警告"
                        Exit Sub
                    Else
                        TxtSql = TxtSql & " and " & Cmb3.Text & " " & Like3.Text & " '" & Trim(Txt03.Text) & "' "
                    End If
                Else
                    If Like3.Text = "Like" Then
                        MsgBox "日期数据不支持“LIKE”！", vbOKOnly + vbExclamation, "警告"
                        Exit Sub
                    Else
                        TxtSql = TxtSql & Cmb3.Text & " " & Like3.Text & " '" & Trim(Txt03.Text) & "' "
                    End If
                End If
            Else
                dd(2) = True
                If dd(0) Or dd(1) Then
                    If Like3.Text = "Like" Then
                        TxtSql = TxtSql & " and " & Cmb3.Text & " " & Like3.Text & " '%" & Trim(Txt03.Text) & "%' "
                    Else
                        TxtSql = TxtSql & " and " & Cmb3.Text & " " & Like3.Text & " '" & Trim(Txt03.Text) & "' "
                    End If
                Else
                    If Like3.Text = "Like" Then
                        TxtSql = TxtSql & Cmb3.Text & " " & Like3.Text & " '%" & Trim(Txt03.Text) & "%' "
                    Else
                        TxtSql = TxtSql & Cmb3.Text & " " & Like3.Text & " '" & Trim(Txt03.Text) & "' "
                    End If
                End If
            End If
        End If
    End If
    
    If Not (dd(0) Or dd(1) Or dd(2) Or dd(3)) Then
        MsgBox "请设置查询方式！", vbOKOnly + vbExclamation, "警告"
        txt01.Text = ""
        Txt02.Text = ""
        Txt03.Text = ""
        Exit Sub
    End If
        TxtSql = TxtSql & "order by 送检日期"
      Set Rstmp = New ADODB.Recordset
    Rstmp.Open TxtSql, Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
      Set DataGrid2.DataSource = Rstmp
      'Rstmp.Close
      'Set Rstmp = Nothing
    Exit Sub
ErrLine:
    MsgBox Err.Description, vbCritical, "查询出错提示："

        txt01.Text = ""
        Txt02.Text = ""
        Txt03.Text = ""
    Exit Sub
End Sub


Private Sub Command1_Click()
    Call Toolbjzt
    TxtSjs.Text = ""
    TxtYjp.Text = ""
    TxtLys.Text = ""
    TxtZej.Text = ""
    TxtCej.Text = ""
    TxtZbf.Text = ""
    TxtCbf.Text = ""
    TxtFgs.Text = ""
    AddFlg = True
End Sub

Private Sub Command10_Click()
    Cdlg.DialogTitle = "另存为Excel文件："
    Cdlg.Filter = "Excel文件|*.Xls|所有文件|*.*"
    Cdlg.ShowSave
    If Cdlg.FileName = "" Then Exit Sub
         OutTxt.Text = Cdlg.FileName
End Sub

Private Sub Command11_Click()
    On Error GoTo errs
        Dim Rs As ADODB.Recordset
        Dim ExcelApp As Excel.Application
        Dim ExcelBook As Excel.Workbook
        Dim ExcelSheet As Excel.Worksheet
    
        Set ExcelApp = New Excel.Application
        ExcelApp.Visible = False
        Set ExcelBook = ExcelApp.Workbooks.Add
        Set ExcelSheet = ExcelBook.Worksheets.Item(1)
        
        Set Rs = New ADODB.Recordset
         
        Rs.Open TxtSql, Cw_DataEnvi.DataConnect, , adLockPessimistic, adCmdText
        RecordsetToExcel Rs, ExcelSheet
        If OutTxt.Text = "" Then
          MsgBox "请指定输出文件位置和文件名！", 16, "严重错误"
          Exit Sub
        End If
        On Error GoTo ErrSave
         ExcelBook.Close True, OutTxt.Text
         MsgBox "输出成功！文件位于" & OutTxt.Text
         Rs.Close
    
    Exit Sub
errs:
        MsgBox "Select 语句错误！", 16, "严重错误"
        ExcelBook.Close False
         Exit Sub
ErrSave:
        MsgBox "输出错误！", 16, "严重错误"
End Sub

Private Sub Command12_Click()
    Frm选择产品图号.Show 1
End Sub

Private Sub CmbPM_LostFocus()
      Dim Mrc As ADODB.Recordset
      Set Mrc = New ADODB.Recordset
      TxtSql = "select * from Bs_产品图号 where 品名='" & CmbPM.Text & "'"
      Mrc.Open Trim$(TxtSql), Cw_DataEnvi.DataConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
        If Mrc.EOF = True Then
            MsgBox "没有此品名！"
            CmbTH.Text = ""
            TxtGG.Text = ""
            CmbTH.SetFocus
            Exit Sub
        End If
        CmbTH.Text = Mrc!图号
        TxtGG.Text = Mrc!规格
        Mrc.Close
End Sub

Private Sub CmbTH_LostFocus()
      Dim Mrc As ADODB.Recordset
      Set Mrc = New ADODB.Recordset
      TxtSql = "select * from Bs_产品图号 where 图号='" & CmbTH.Text & "'"
      Mrc.Open Trim$(TxtSql), Cw_DataEnvi.DataConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
        If Mrc.EOF = True Then
            CmbPM.Text = ""
            TxtGG.Text = ""
            Exit Sub
        End If
        CmbPM.Text = Mrc!品名
        TxtGG.Text = Mrc!规格
        Mrc.Close
End Sub

Private Sub Command2_Click()
    Call Toolbjzt
    AddFlg = False
End Sub

Private Sub Command3_Click()
    If BoolDate(DTPSjrq.Value) = False Or RsQx() = False Then
        If Not Security_Log("XT_Modify ", Xtczybm, 1, True) Then
            
            Exit Sub
        End If
    End If
    If vbYes = MsgBox("确认要删除此记录么？(" & Lablsh.Caption & ")", vbYesNo, "删除对话框") Then
        CmdExe.CommandText = "delete  from Dm_检验表 where id='" & Lablsh.Caption & "'"
        CmdExe.Execute
    End If
    Call Toolfbjzt
    Call ToolList
End Sub


Private Sub Command4_Click()
   If AddFlg = True Then  '添加
        If BoolDate(DTPSjrq.Value) = False Then
            If Not Security_Log("XT_Modify ", Xtczybm, 1, True) Then
                
                Exit Sub
            End If
        End If
   Else                     '修改
        If BoolDate(DTPSjrq.Value) = False Or RsQx() = False Then
            If Not Security_Log("XT_Modify ", Xtczybm, 1, True) Then
                
                Exit Sub
            End If
        End If
    End If
Set Mrc = New ADODB.Recordset
  
If Trim(CmbZjr.Text) = "" Then
        CmbZjr.SetFocus
        MsgBox "请正确填选员工姓名！"
        Exit Sub
Else
      Set Mrc = New ADODB.Recordset
      TxtSql = "select * from Bs_员工明细 where 员工姓名 = '" & CmbZjr.Text & "' and 部门名称='" & CmbBmmc.Text & "'"
      Mrc.Open Trim$(TxtSql), Cw_DataEnvi.DataConnect, adOpenKeyset, adLockOptimistic
      Set ExecuteSQL = Mrc
      
        If Mrc.EOF = True Then
            CmbZjr.SetFocus
            MsgBox "请正确填选员工姓名！"
            Exit Sub
        End If
        Mrc.Close
End If

If Trim(CmbCpr.Text) = "" Then
        CmbCpr.SetFocus
        MsgBox "请正确填选员工姓名！"
        Exit Sub
Else
      Set Mrc = New ADODB.Recordset
      TxtSql = "select * from Bs_员工明细 where 员工姓名 = '" & CmbCpr.Text & "' and 部门名称='" & CmbBmmc.Text & "'"
      Mrc.Open Trim$(TxtSql), Cw_DataEnvi.DataConnect, adOpenKeyset, adLockOptimistic
      Set ExecuteSQL = Mrc
      
        If Mrc.EOF = True Then
            CmbCpr.SetFocus
            MsgBox "请正确填选员工姓名！"
            Exit Sub
        End If
        Mrc.Close
End If

If Trim(CmbTH.Text) = "" Then
        CmbTH.SetFocus
        MsgBox "请正确填选图号、品名规格！"
        Exit Sub
Else
      Set Mrc = New ADODB.Recordset
      TxtSql = "select * from Bs_产品图号 where 图号='" & CmbTH.Text & "'"
      Mrc.Open Trim$(TxtSql), Cw_DataEnvi.DataConnect, adOpenKeyset, adLockOptimistic
      Set ExecuteSQL = Mrc
      
        If Mrc.EOF = True Then
            CmbTH.SetFocus
            MsgBox "请正确填选图号、品名规格！"
            Exit Sub
        End If
        CmbPM.Text = Mrc!品名
        TxtGG.Text = Mrc!规格
        Mrc.Close
End If

If Trim(CmbCK1.Text) = "" Then
        CmbCK1.SetFocus
        MsgBox "请正确填选仓库名称！"
        Exit Sub
Else
      Set Mrc = New ADODB.Recordset
      TxtSql = "select * from Bs_仓库列表 where 仓库名称 = '" & CmbCK1.Text & "'"
      Mrc.Open Trim$(TxtSql), Cw_DataEnvi.DataConnect, adOpenKeyset, adLockOptimistic
      Set ExecuteSQL = Mrc
      
        If Mrc.EOF = True Then
            CmbCK1.SetFocus
            MsgBox "请正确填选仓库名称！"
            Exit Sub
        End If
        T
上一页 1 2 3 45
💿 文件大小 5181 K
👤 上传用户 sunqingyan
📂 所属分类 SQL Server
🏷️ 相关标签

#企业管理
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -