frmbmcx.frm

vb程序设计仁宇人份管理

Dim strLjf As String
Dim strSQL As String
Dim strOrder As String
Dim strBm As String
'选择查询表目
Private Sub CmbBm_Click()
        strBm = Trim(Right(CmbBm.Text, 8))     '''''''表目
        Select Case strBm
        Case "khbm"
           strOrder = " order by 单位编码 "
        Case "bmbm"
           strOrder = " order by 部门编码 "
        Case "cpbm"
           strOrder = " order by 产品编码 "
        Case "dqbm"
           strOrder = " order by 地区编码 "
        Case "sfbm"
           strOrder = " order by 省份编码 "
        Case "dzbm"
           strOrder = " order by 到站编码 "
        Case "djbm"
           strOrder = " order by 到局编码 "
        Case "zcdd"
           strOrder = " order by 地点编码 "
        Case "xcp"
           strOrder = " order by 新产品编码 "
        Case "lqxz"
           strOrder = " order by 来款性质编码 "
        End Select
        '客户编码时选择字段,其它编码表全选
        If strBm = "khbm" Then
           strSQL = "select 客户序号,单位编码,单位名称,简称,开户行,账号,税号,地址,电话,传真,邮编,部门,省份,业务地区,发货性质,帐面余额,联系人,联系人电话,综合地区,电子信箱,主页,流水号,法人,所属科室 from KHBM"
        Else
           strSQL = "select * from " & Trim(Right(CmbBm.Text, 8))
        End If
        'SQL查询
        If rsCx.State = adStateOpen Then rsCx.Close
        rsCx.Open strSQL & strOrder, dblgjx, adOpenDynamic, adLockOptimistic
        WrtCell
        CmbZd.Clear
        For i = 0 To rsCx.Fields.Count - 1
            CmbZd.AddItem rsCx.Fields(i).Name
        Next
    
    strLjf = " and"
    cmdtj(0).Enabled = False
    '刷新条件框
    listTj.Clear
    
End Sub

Private Sub CmbYsf_Click()
    If Trim(CmbYsf.Text) = "" Then Exit Sub
    Text1 = ""
    Text2 = ""
    txtV1 = ""
    nType = 0
    Select Case rsCx.Fields(CmbZd.ListIndex).Type
    Case adVarChar, adChar
        pctValue1.Visible = True
        pctValue2.Visible = False
        pctDate1.Visible = False
        pctDate2.Visible = False
        If CmbYsf.ListIndex = 0 Then nType = 10
        If CmbYsf.ListIndex = 1 Then nType = 11
        If CmbYsf.ListIndex = 2 Then nType = 12
        If CmbYsf.ListIndex = 3 Then nType = 13
        If CmbYsf.ListIndex = 4 Then nType = 14
        If CmbYsf.ListIndex = 5 Then nType = 15
        
    Case adNumeric, adVarNumeric
        If CmbYsf.ListIndex = 6 Then
            pctValue1.Visible = False
            pctValue2.Visible = True
            pctDate1.Visible = False
            pctDate2.Visible = False
            nType = 26
        Else
            pctValue1.Visible = True
            pctValue2.Visible = False
            pctDate1.Visible = False
            pctDate2.Visible = False
            nType = 20
        End If
    Case adDBTimeStamp
        If CmbYsf.ListIndex = 6 Then
            pctValue1.Visible = False
            pctValue2.Visible = False
            pctDate1.Visible = False
            pctDate2.Visible = True
            nType = 36
        Else
            pctValue1.Visible = False
            pctValue2.Visible = False
            pctDate1.Visible = True
            pctDate2.Visible = False
            nType = 30
        End If
    End Select
End Sub

Private Sub CmbZd_Click()
    Text1 = ""
    Text2 = ""
    txtV1 = ""
    If CmbZd.ListIndex <> -1 Then
    Select Case rsCx.Fields(CmbZd.ListIndex).Type
    Case adVarChar, adChar
        CmbYsf.Clear
        CmbYsf.AddItem "包 含"
        CmbYsf.AddItem "向前包含"
        CmbYsf.AddItem "向后包含"
        CmbYsf.AddItem "等 于                       ="
        CmbYsf.AddItem "大 于                       >"
        CmbYsf.AddItem "小 于                       <"
    Case adNumeric, adVarNumeric, adDBTimeStamp
        CmbYsf.Clear
        CmbYsf.AddItem "等于                       ="
        CmbYsf.AddItem "小于                       <"
        CmbYsf.AddItem "小于等于                  <="
        CmbYsf.AddItem "大于                       >"
        CmbYsf.AddItem "大于等于                  >="
        CmbYsf.AddItem "不等于                    <>"
        CmbYsf.AddItem "介于"
    End Select
   End If

End Sub

Private Sub cmdClose_Click(Index As Integer)
Unload Me

End Sub

Private Sub CmdCx_Click(Index As Integer)
    Dim strWhere As String
    Select Case Index
    Case 0
    Case 1
       
    Case 2
      If rsCx.State = adStateOpen Then rsCx.Close
      If Trim(Right(CmbBm.Text, 8)) = "khbm" Then
        
        If listTj.ListCount = 0 Then
            rsCx.Open strSQL & " where 最新标志='1'" & strOrder, dblgjx, adOpenDynamic, adLockOptimistic
        Else
            strWhere = ""
            For i = 0 To listTj.ListCount - 1
                strWhere = strWhere & listTj.List(i) & " "
            Next
            strWhere = Mid(strWhere, 1, Len(strWhere) - 4)
            rsCx.Open strSQL & " where " & strWhere & " and  最新标志='1'" & strOrder, dblgjx, adOpenDynamic, adLockOptimistic
            
            
        End If
               
        
      Else
         If listTj.ListCount = 0 Then
            rsCx.Open strSQL & strOrder, dblgjx, adOpenDynamic, adLockOptimistic
        Else
            strWhere = ""
            For i = 0 To listTj.ListCount - 1
                strWhere = strWhere & listTj.List(i) & " "
            Next
            strWhere = Mid(strWhere, 1, Len(strWhere) - 4)
            rsCx.Open strSQL & " where " & strWhere & strOrder, dblgjx, adOpenDynamic, adLockOptimistic
        End If
        
     End If
     
        WrtCell
        cmdtj(0).Enabled = True
        
    End Select
    
End Sub

Private Sub cmdtj_Click(Index As Integer)
   If rsCx.RecordCount > 0 Then
      MsgBox "符合条件的记录共有" & rsCx.RecordCount & "条！", 64, "统计结果"
   Else
      MsgBox "不存在符合条件的记录！", 64, "统计结果"
   End If
   
End Sub

Private Sub Command1_Click(Index As Integer)
    Dim strTj As String
    Select Case Index
    Case 0
        If CmbZd.ListIndex >= 0 And CmbYsf.ListIndex >= 0 Then
            Select Case nType
            Case 10
                If Trim(txtV1) <> "" Then
                    strTj = Trim(CmbZd.Text) & " like '%" & Trim(txtV1) & "%'"
                Else
                    Exit Sub
                End If
            Case 11
                If Trim(txtV1) <> "" Then
                    strTj = Trim(CmbZd.Text) & " like '" & Trim(txtV1) & "%'"
                Else
                    Exit Sub
                End If
            Case 12
                If Trim(txtV1) <> "" Then
                    strTj = Trim(CmbZd.Text) & " like '%" & Trim(txtV1) & "'"
                Else
                    Exit Sub
                End If

            Case 13, 14, 15
                If Trim(txtV1) <> "" Then
                    strTj = Trim(CmbZd.Text) & Right(CmbYsf.Text, 1) & "'" & Trim(txtV1) & "'"
                Else
                    Exit Sub
                End If
                
            Case 20
                If Trim(txtV1) <> "" And IsNumeric(txtV1) Then
                    strTj = Trim(CmbZd.Text) & Trim(Right(CmbYsf.Text, 2)) & Trim(txtV1)
                Else
                    Exit Sub
                End If
            Case 26
                If Trim(Text1) <> "" And Trim(Text2) <> "" And IsNumeric(Text1) And IsNumeric(Text2) Then
                    strTj = Trim(CmbZd.Text) & " between " & Trim(Text1) & " and " & Trim(Text2)
                Else
                    Exit Sub
                End If
            Case 30
                strTj = Trim(CmbZd.Text) & Trim(Right(CmbYsf.Text, 2)) & "to_date('" & Format(DTPicker1.Value, "yyyymmdd") & "','yyyymmdd')"
            Case 36
                strTj = Trim(CmbZd.Text) & " between " & "to_date('" & Format(DTPicker2.Value, "yyyymmdd") & "','yyyymmdd') and " & "to_date('" & Format(DTPicker3.Value, "yyyymmdd") & "','yyyymmdd')"
            End Select
            
            listTj.AddItem strTj & strLjf
        Else
            MsgBox "请选择需查询的字段！"
        End If
    Case 1
        If listTj.ListIndex <> -1 Then
            listTj.RemoveItem listTj.ListIndex
            
        End If
    End Select
End Sub


Private Sub Command2_Click()
Cell1.DoPrintPreview True
End Sub

Private Sub Form_Load()
Cell1.DoLogin "HOLLYWAY", 294, "1404900178057C05E403710A870A"
        
   CmbBm.Clear
   CmbBm.AddItem "客户编码　　             khbm"
   CmbBm.AddItem "产品编码                 cpbm"
   CmbBm.AddItem "部门编码                 bmbm"
   CmbBm.AddItem "业务地区编码             dqbm"
   CmbBm.AddItem "省份编码                 sfbm"
   CmbBm.AddItem "到站编码                 dzbm"
   CmbBm.AddItem "到局编码                 djbm"
   CmbBm.AddItem "新产品编码                xcp"
   CmbBm.AddItem "装车地点编码             zcdd"
   CmbBm.AddItem "来款性质编码             lqxz"
   
   Iskhbm = False
   CmbBm.ListIndex = 0
   CmbZd.ListIndex = 0
   strSQL = "select 客户序号,单位编码,单位名称,简称,开户行,账号,税号,地址,电话,传真,邮编,部门,省份,业务地区,发货性质,帐面余额,联系人,联系人电话,综合地区,电子信箱,主页,流水号,法人,所属科室 from KHBM"
   If rsCx.State = adStateOpen Then rsCx.Close
   rsCx.Open strSQL & " order by 单位编码 "
   WrtCell
End Sub

'选择逻辑连接符以确定所加条件之间的逻辑关系
Private Sub Option1_Click(Index As Integer)
    If Index = 0 Then
        strLjf = " and"
    Else
        strLjf = " or"
    End If
End Sub


Private Sub WrtCell()
Dim FldCount As Integer
    '清空足够的行和列
    Cell1.DoDeleteCol 0, 30
    Cell1.DoDeleteRow 1, 2000
    '不同的编码表对应不同的字段数
    Select Case CmbBm.ListIndex
    Case 0
      FldCount = 24
    Case 1
      FldCount = 12
    Case 2, 3, 4, 6, 8
      FldCount = 2
    Case 5, 7
      FldCount = 4
    Case 9
      FldCount = 3
    End Select
    '写字段名至顶筐
    For j = 0 To FldCount - 1
      Cell1.DoAppendCol 1
      Cell1.DoSetCellString j, -1, rsCx(j).Name
    Next
    '判断是否有数据
    If rsCx.RecordCount <= 0 Then
       Exit Sub
    End If
    '写数据
    rsCx.MoveFirst
    Cell1.DoAppendRow rsCx.RecordCount - 1
    For i = 0 To rsCx.RecordCount - 1
      For j = 0 To FldCount - 1
        If rsCx(j) <> "" Then Cell1.DoSetCellString j, i, rsCx(j)
      Next
      rsCx.MoveNext
    Next
    '设只读
    For i = 0 To FldCount - 1
      For j = 0 To rsCx.RecordCount - 1
        Cell1.DoSetCellReadOnly i, j, True
      Next
    Next
End Sub