📄 formcond.cls
字号:
mstrSelected(mlngCurentline, 5) = " > "
Case "小于"
mstrSelected(mlngCurentline, 5) = " < "
Case "大于等于"
mstrSelected(mlngCurentline, 5) = " >= "
Case "小于等于"
mstrSelected(mlngCurentline, 5) = " <= "
End Select
mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & mstrSelected(mlngCurentline, 5) & Trim(.txtFrom.Text)
'** End OF IF 4 **
End If
'** End OF IF 3 **
End If
'** Else Of If 2 **
Else
'** If 5 **
If UCase(mCurstrTemp(3)) = "STRING" Then
If Filter.NotValild(.txtFrom.Text) Then
MsgBox "输入了非法字符,如:单引号."
Exit Sub
End If
If Len(.txtFrom.Text) > 255 Then
MsgBox "输入的字符串长度超过了允许录入的最大字符个数--255,请重新录入."
Exit Sub
End If
'** If 6 **
If .ReferText1.Text = "介于" Then
If Filter.NotValild(.txtTo.Text) Or Len(.txtTo.Text) > 255 Or Trim(.txtFrom.Text) > Trim(.txtTo.Text) Then
Exit Sub
End If
If .ActiveControl.Name = "TxtTo" Or .ActiveControl.Name = "ReferText1" Then Exit Sub
'把当前行加入已选数组
Modifyrefertext1 frmFilterSet
mstrSelected(mlngCurentline, 5) = .ReferText1.Text
mstrSelected(mlngCurentline, 6) = Trim(.txtFrom.Text)
mstrSelected(mlngCurentline, 7) = Trim(.txtTo.Text)
mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " >= '" & Trim(mstrSelected(mlngCurentline, 6)) & "' and " & mstrSelected(mlngCurentline, 2) & " <= '" & Trim(mstrSelected(mlngCurentline, 7)) & "'"
AddSelectedTag frmFilterSet
.MsgFilter.TextMatrix(mlngCurentline, 1) = .ReferText1.Text & " (" & .txtFrom.Text & " , " & .txtTo.Text & ")"
AddMsgFilter frmFilterSet
Exit Sub
'** Else Of IF 6 **
Else
'把当前行加入已选数组
Modifyrefertext1 frmFilterSet
Select Case .ReferText1.Text
Case "等于" '处理编码级次的“等于”
Select Case mstrSelected(mlngCurentline, 1)
Case "科目编码", "部门编码", "统计编码", "项目编码", "货位编码", "商品类型编码", "单位类型编码", "固资类别编码", "职员类别编码"
mstrSelected(mlngCurentline, 8) = "(" & mstrSelected(mlngCurentline, 2) & " = " & "'" & .txtFrom.Text & "' or " & mstrSelected(mlngCurentline, 2) & " LIKE " & "'" & .txtFrom.Text & "-%')"
Case "科目全称", "部门全称", "统计全称", "项目全称", "货位全称", "商品类型全称", "单位类型全称", "固资类别全称", "职员类别全称"
mstrSelected(mlngCurentline, 8) = "(" & mstrSelected(mlngCurentline, 2) & " = " & "'" & .txtFrom.Text & "' or " & mstrSelected(mlngCurentline, 2) & " LIKE " & "'" & .txtFrom.Text & "-%')"
Case Else
mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " = " & "'" & .txtFrom.Text & "'"
End Select
Case "不等于"
mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " <> " & "'" & .txtFrom.Text & "'"
Case "大于"
mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " > " & "'" & .txtFrom.Text & "'"
Case "小于"
mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " < " & "'" & .txtFrom.Text & "'"
Case "大于等于"
mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " >= " & "'" & .txtFrom.Text & "'"
Case "小于等于"
mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " <= " & "'" & .txtFrom.Text & "'"
Case "打头字符为"
mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " like " & "'" & Trim(.txtFrom.Text) & "%' "
Case "包含字符"
mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " like " & "'" & "%" & Trim(.txtFrom.Text) & "%'"
Case "类似于" '处理编码级次的 “类似于”
Select Case mstrSelected(mlngCurentline, 1)
Case "科目编码", "部门编码", "统计编码", "项目编码", "货位编码", "商品类型编码", "单位类型编码", "固资类别编码", "职员类别编码"
mstrSelected(mlngCurentline, 8) = "(" & mstrSelected(mlngCurentline, 2) & " like " & "'" & .txtFrom.Text & "' or " & mstrSelected(mlngCurentline, 2) & " LIKE " & "'" & .txtFrom.Text & "-%')"
Case "科目全称", "部门全称", "统计全称", "项目全称", "货位全称", "商品类型全称", "单位类型全称", "固资类别全称", "职员类别全称"
mstrSelected(mlngCurentline, 8) = "(" & mstrSelected(mlngCurentline, 2) & " like " & "'" & .txtFrom.Text & "' or " & mstrSelected(mlngCurentline, 2) & " LIKE " & "'" & .txtFrom.Text & "-%')"
Case Else
mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " like " & "'" & .txtFrom.Text & "'"
End Select
' mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " like " & "'" & .TxtFrom.Text & "'"
End Select
'** End Of If 6 **
End If
'** Else Of If 5 **
Else
MsgBox "无效输入"
Exit Sub
'** End Of If 5 **
End If
'** END OF IF 2 **
End If
mstrSelected(mlngCurentline, 5) = .ReferText1.Text
mstrSelected(mlngCurentline, 6) = .txtFrom.Text
AddSelectedTag frmFilterSet
.MsgFilter.TextMatrix(mlngCurentline, 1) = .ReferText1.Text & " " & mstrSelected(mlngCurentline, 6)
AddMsgFilter frmFilterSet
'** ELSE OF IF 1 **.
Else
If .ReferText1.Text <> "介于" And Left(.tvwFilter.Nodes(mlngCurLineOfSelect).Tag, 1) = "*" Then
'删去当前行
DelCurentline frmFilterSet
End If
'** END OF IF 1 **
End If
End With
End Sub
Public Sub refertext2_Choose(frmFilterSet As Form)
Dim D1 As Date, D2 As Date
If mblnRefertext2 = False Then Exit Sub
mblnRefertext2 = False
If frmFilterSet.ReferText2.Text = "自定义" Then
If Not (frmFilterSet.DateFrom.Text = "") And Not (frmFilterSet.DateTo.Text = "") Then
If CDate(frmFilterSet.DateFrom.Text) <= CDate(frmFilterSet.DateTo.Text) Then
ModifyReferText2 frmFilterSet
End If
End If
Exit Sub
End If
frmFilterSet.DateFrom.Text = ""
frmFilterSet.DateTo.Text = ""
gclsBase.GetBeginAndEndDate frmFilterSet.ReferText2.Text, gclsBase.BaseDate, D1, D2
frmFilterSet.DateFrom.Text = Format(D1, "yyyy-mm-dd")
frmFilterSet.DateTo.Text = Format(D2, "yyyy-mm-dd")
If Trim(frmFilterSet.ReferText2.Text) = "所有" Then
frmFilterSet.DateFrom.Text = ""
frmFilterSet.DateTo.Text = ""
If Left(frmFilterSet.tvwFilter.Nodes(mlngCurLineOfSelect).Tag, 1) = "*" Then
frmFilterSet.ReferText2.Text = ""
frmFilterSet.picAccount.Enabled = False
'删去当前行
DelCurentline frmFilterSet
Exit Sub
End If
Exit Sub
End If
'把当前行加入已选数组
ModifyReferText2 frmFilterSet
End Sub
'加上已选标记
Private Sub AddSelectedTag(frmFilterSet As Form)
' Insert One Line Into MsgFilter
If Left(frmFilterSet.tvwFilter.Nodes(mlngCurLineOfSelect).Tag, 1) <> "*" Then
frmFilterSet.tvwFilter.Nodes(mlngCurLineOfSelect).Tag = "*" & frmFilterSet.tvwFilter.Nodes(mlngCurLineOfSelect).Tag
frmFilterSet.MsgFilter.Rows = frmFilterSet.MsgFilter.Rows + 1
frmFilterSet.MsgFilter.RowHeight(frmFilterSet.MsgFilter.Rows - 1) = 0
mintMaxSelLines = frmFilterSet.MsgFilter.Rows - 2
End If
End Sub
'删去当前行
Private Sub DelCurentline(frmFilterSet As Form)
Dim Index As Long
Dim index2 As Long
On Error Resume Next
With frmFilterSet
.tvwFilter.Nodes(mlngCurLineOfSelect).Tag = Right(.tvwFilter.Nodes(mlngCurLineOfSelect).Tag, Len(.tvwFilter.Nodes(mlngCurLineOfSelect).Tag) - 1)
.MsgFilter.RemoveItem (mlngCurentline)
Index = mlngCurentline
Do While Index < .MsgFilter.Rows - 1
For index2 = 1 To ConNumPerSel
mstrSelected(Index, index2) = mstrSelected(Index + 1, index2)
Next
Index = Index + 1
Loop
.MsgFilter.RowHeight(.MsgFilter.Rows - 1) = 0
mintMaxSelLines = .MsgFilter.Rows - 2
If .MsgFilter.Rows - 1 > mlngCurentline Then
.MsgFilter.Row = mlngCurentline
MsgFilter_click frmFilterSet
Else
If mlngCurentline > 1 Then
.MsgFilter.Row = mlngCurentline - 1
MsgFilter_click frmFilterSet
End If
End If
End With
End Sub
'删去指定行
Public Function DelLine(frmFilterSet As Form, lngDelLine As Long) As Boolean
On Error GoTo EndFuntion
With frmFilterSet
If .MsgFilter.Rows - 2 >= lngDelLine Then
.MsgFilter.Row = lngDelLine
MsgFilter_click frmFilterSet
DelCurentline frmFilterSet
DelLine = True
Exit Function
End If
End With
EndFuntion:
DelLine = False
End Function
'定位输入字段到已选数组的位置.
Public Function PositionLine(frmFilterSet As Form, strDesc As String) As Long
On Error GoTo EndPosition
Dim Index As Long
For Index = 1 To frmFilterSet.MsgFilter.Rows - 2
If mstrSelected(Index, 11) = strDesc Then
PositionLine = Index
Exit Function
End If
Next
EndPosition:
PositionLine = 0
End Function
'把当前行加入已选 msgFiter
Private Sub AddMsgFilter(frmFilterSet As Form)
With frmFilterSet
.MsgFilter.RowHeight(mlngCurentline) = 255
.MsgFilter.TextMatrix(mlngCurentline, 0) = mstrSelected(mlngCurentline, 1)
.MsgFilter.RowData(mlngCurentline) = mstrSelected(mlngCurentline, 9)
.MsgFilter.ColAlignment(1) = 1
.MsgFilter.Row = mlngCurentline
If Not .MsgFilter.RowIsVisible(mlngCurentline) Then
If mlngCurentline > 5 Then
.MsgFilter.TopRow = mlngCurentline - 4
Else
.MsgFilter.TopRow = mlngCurentline
End If
End If
End With
End Sub
'把当前行加入已选数组
Private Sub Modifyrefertext1(frmFilterSet As Form)
Dim strtemps() As String
Dim strChineseTemp() As String
Dim Index As Long
Dim index2 As Long
If mblnSelected = False Then
ReDim strtemps(frmFilterSet.MsgFilter.Rows - 1, 1 To ConNumPerSel) As String
ReDim strChineseTemp(frmFilterSet.MsgFilter.Rows - 1)
For Index = 1 To frmFilterSet.MsgFilter.Rows - 2
For index2 = 1 To ConNumPerSel
strtemps(Index, index2) = mstrSelected(Index, index2)
Next
On Error Resume Next
Next
ReDim mstrSelected(1 To frmFilterSet.MsgFilter.Rows - 1, 1 To ConNumPerSel)
For Index = 1 To frmFilterSet.MsgFilter.Rows - 2
For index2 = 1 To ConNumPerSel
mstrSelected(Index, index2) = strtemps(Index, index2)
Next
Next
End If
frmFilterSet.MsgFilter.RowHeight(mlngCurentline) = 255
mstrSelected(mlngCurentline, 1) = mCurstrTemp(1)
mstrSelected(mlngCurentline, 2) = mCurstrTemp(2)
mstrSelected(mlngCurentline, 3) = UCase(mCurstrTemp(3))
mstrSelected(mlngCurentline, 4) = mCurstrTemp(4)
mstrSelected(mlngCurentline, 9) = mCurstrTemp(5)
mstrSelected(mlngCurentline, 10) = mCurstrTemp(6)
mstrSelected(mlngCurentline, 11) = mCurstrTemp(7)
mstrSelected(mlngCurentline, 12) = mCurstrTemp(8)
mstrSelected(mlngCurentline, 13) = mCurstrTemp(9)
mblnSelected = True
End Sub
'把当前行加入已选数组
Private Sub ModifyReferText2(frmFilterSet As Form)
Dim strtemps() As String
Dim strChineseTemp() As String
Dim Index As Long
Dim index2 As Long
If mblnSelected = False Then
ReDim strtemps(1 To frmFilterSet.MsgFilter.Rows - 1, 1 To ConNumPerSel) As String
ReDim strChineseTemp(1 To frmFilterSet.MsgFilter.Rows - 1)
For Index = 1 To frmFilterSet.MsgFilter.Rows - 2
For index2 = 1 To ConNumPerSel
strtemps(Index, index2) = mstrSelected(Index, index2)
Next
On Error Resume Next
Next
ReDim mstrSelected(1 To frmFilterSet.MsgFilter.Rows - 1, 1 To ConNumPerSel)
'**
For Index = 1 To frmFilterSet.MsgFilter.Rows - 2
For index2 = 1 To ConNumPerSel
mstrSelected(Index, index2) = strtemps(Index, index2)
Next
Next
End ⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -