📄 frmxsfsbmcx.frm
字号:
AutoSize = -1 'True
Caption = "逻辑连接符:"
Height = 180
Index = 8
Left = 90
TabIndex = 5
Top = 1275
Width = 1080
End
End
End
End
Attribute VB_Name = "frmXsfsbmcx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rsCx As Recordset
Dim nType As Integer
Dim strLjf As String
Dim strSQL As String
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 = ""
''''根据字段的不同类型添加不同的运算符
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 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 listTj.ListCount = 0 Then
rsCx.Open strSQL, 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 & " order by 销售方式编码 ", dblgjx, adOpenDynamic, adLockOptimistic
End If
WrtCell 3
cmdtj(0).Enabled = True
End Select
End Sub
Private Sub CmdExit_Click(Index As Integer)
frmXSFSbm.Show
Unload Me
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 commZcsx_Click(Index As Integer)
End Sub
Private Sub Command2_Click()
Cell1.DoPrintPreview True
End Sub
Private Sub DataGrid1_DblClick()
frmXSFSbm.Tag = rsCx("销售方式编码")
frmXSFSbm.Show vbModal
' Dim i As Integer
' For i = 0 To 20
' If rsCx(i) <> "" Then frmKHBM.txtfields(i).text = rsCx(i)
' Next
' If rsCx(23) <> "" Then frmKHBM.txtfields(21) = rsCx(23)
' frmKHBM.lblStatus.Caption = "查询选中的记录"
' frmKHBM.Show
End Sub
Private Sub Form_Load()
Cell1.DoLogin "HOLLYWAY", 294, "1404900178057C05E403710A870A"
Set rsCx = New Recordset
strSQL = "select * from xsfs "
rsCx.Open strSQL & " order by 销售方式编码 ", dblgjx, adOpenDynamic, adLockOptimistic
WrtCell 3
For i = 0 To rsCx.Fields.Count - 1
CmbZd.AddItem rsCx.Fields(i).Name
Next
strLjf = " and"
cmdtj(0).Enabled = False
CmbZd.ListIndex = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
If rsCx.State = adStateOpen Then rsCx.Close
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(FldCount As Integer)
Cell1.DoDeleteCol 0, 30
Cell1.DoDeleteRow 1, 2000
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
Private Sub Cell1_OnDClickGrid(ByVal col As Long, ByVal row As Long)
Cell1.DoGetCellData 0, row, strBm
frmXSFSbm.Tag = strBm
If strBm <> "" Then frmXSFSbm.Show vbModal
End Sub
Private Sub Cell1_OnDClickSideLabel(ByVal row As Long)
Cell1.DoGetCellData 0, row, strBm
frmXSFSbm.Tag = strBm
If strBm <> "" Then frmXSFSbm.Show vbModal
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -