dlgqueryresult.frm
来自「通用书店管理系统」· FRM 代码 · 共 1,356 行 · 第 1/3 页
FRM
1,356 行
BuddyControl = "txtLocateRow"
BuddyDispid = 196648
OrigLeft = 2745
OrigTop = 315
OrigRight = 3015
OrigBottom = 630
SyncBuddy = -1 'True
BuddyProperty = 65547
Enabled = -1 'True
End
Begin VB.TextBox txtLocateRow
Height = 300
Left = 990
TabIndex = 25
Top = 315
Width = 1620
End
Begin VB.Label lblFields
AutoSize = -1 'True
Caption = "列(&C)："
Height = 180
Index = 6
Left = 240
TabIndex = 27
Top = 750
Width = 630
End
Begin VB.Label lblFields
AutoSize = -1 'True
Caption = "行(&R)："
Height = 180
Index = 5
Left = 240
TabIndex = 24
Top = 360
Width = 630
End
End
Begin VB.Frame fraReplace
Caption = ">> 替换"
Height = 2355
Left = 5790
TabIndex = 10
Top = 90
Width = 5610
Begin VB.TextBox txtReplaceReplaceContent
Height = 315
Left = 165
TabIndex = 22
Top = 1155
Width = 3675
End
Begin VB.CommandButton cmdReplaceAll
Caption = "全部替换(&A)"
Height = 360
Left = 4065
TabIndex = 20
Top = 1395
Width = 1425
End
Begin VB.CheckBox chkReplaceMatch
Caption = "单元格匹配(&O)"
Height = 240
Left = 2535
TabIndex = 19
Top = 1965
Width = 1650
End
Begin VB.CheckBox chkReplaceUcase
Caption = "区分大小写(&C)"
Height = 270
Left = 2535
TabIndex = 18
Top = 1680
Width = 1575
End
Begin VB.ComboBox cboReplaceFashion
Height = 300
ItemData = "dlgQueryResult.frx":0000
Left = 1320
List = "dlgQueryResult.frx":000A
Style = 2 'Dropdown List
TabIndex = 17
Top = 1710
Width = 840
End
Begin VB.CommandButton cmdReplaceOne
Caption = "替换(&R)"
Height = 360
Left = 4065
TabIndex = 15
Top = 990
Width = 1425
End
Begin VB.CommandButton cmdReplaceClose
Caption = "关闭"
Height = 360
Left = 4065
TabIndex = 14
Top = 585
Width = 1425
End
Begin VB.CommandButton cmdReplaceFind
Caption = " 查找下一个(&F)"
Height = 360
Left = 4065
TabIndex = 13
Top = 180
Width = 1425
End
Begin VB.TextBox txtReplaceFindContent
Height = 315
Left = 165
TabIndex = 12
Top = 480
Width = 3675
End
Begin VB.Label lblFields
AutoSize = -1 'True
Caption = "替换内容(&N)："
Height = 180
Index = 4
Left = 150
TabIndex = 21
Top = 915
Width = 1170
End
Begin VB.Label lblFields
AutoSize = -1 'True
Caption = "搜索方式(&S)："
Height = 180
Index = 3
Left = 135
TabIndex = 16
Top = 1740
Width = 1170
End
Begin VB.Label lblFields
AutoSize = -1 'True
Caption = "查找内容(&N)："
Height = 180
Index = 2
Left = 165
TabIndex = 11
Top = 240
Width = 1170
End
End
Begin VB.Frame fraFind
Caption = ">> 查找"
Height = 2190
Left = 60
TabIndex = 0
Top = 105
Width = 5610
Begin VB.CheckBox chkFindMatch
Caption = "单元格匹配(&O)"
Height = 240
Left = 2520
TabIndex = 9
Top = 1740
Width = 1650
End
Begin VB.CheckBox chkFindUcase
Caption = "区分大小写(&C)"
Height = 270
Left = 2520
TabIndex = 8
Top = 1410
Width = 1575
End
Begin VB.ComboBox cboFindFashion
Height = 300
ItemData = "dlgQueryResult.frx":0016
Left = 1305
List = "dlgQueryResult.frx":0020
Style = 2 'Dropdown List
TabIndex = 7
Top = 1440
Width = 840
End
Begin VB.CommandButton cmdFindReplace
Caption = "替换(&R)……"
Enabled = 0 'False
Height = 360
Left = 4050
TabIndex = 5
Top = 1005
Width = 1425
End
Begin VB.CommandButton cmdFindClose
Caption = "关闭"
Height = 360
Left = 4065
TabIndex = 4
Top = 600
Width = 1425
End
Begin VB.CommandButton cmdFindFind
Caption = " 查找下一个(&F)"
Height = 360
Left = 4050
TabIndex = 3
Top = 195
Width = 1425
End
Begin VB.TextBox txtFindContent
Height = 315
Left = 150
TabIndex = 2
Top = 495
Width = 3675
End
Begin VB.Label lblFields
AutoSize = -1 'True
Caption = "搜索方式(&S)："
Height = 180
Index = 1
Left = 120
TabIndex = 6
Top = 1470
Width = 1170
End
Begin VB.Label lblFields
AutoSize = -1 'True
Caption = "查找内容(&N)："
Height = 180
Index = 0
Left = 150
TabIndex = 1
Top = 255
Width = 1170
End
End
End
Attribute VB_Name = "dlgQueryResult"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public frmQR As frmQueryResult '定义一个查询结果窗体，用于传递变量
Private lngFindBeginColumn '查找初始列
'控件初始化
Private Sub iniControls()
Dim i&, j&
Dim strTemp$
'查找/'替换
Me.txtFindContent = ""
Me.txtReplaceFindContent = ""
Me.txtReplaceReplaceContent = ""
With Me.cboFindFashion
.Clear
.AddItem "当前列"
.AddItem "全部"
.ListIndex = 0
End With
With Me.cboReplaceFashion
.Clear
.AddItem "当前列"
.AddItem "全部"
.ListIndex = 0
End With
Me.txtFindContent = frmQR.fg.Cell(flexcpText, frmQR.fg.RowSel, frmQR.fg.ColSel)
Me.txtReplaceFindContent = frmQR.fg.Cell(flexcpText, frmQR.fg.RowSel, frmQR.fg.ColSel)
lngFindBeginColumn = 1
'定位
Me.txtLocateCol = 1
Me.txtLocateRow = frmQR.fg.FixedRows
Me.udLocateCol.Min = 1
Me.udLocateCol.Max = frmQR.fg.Cols - 1
Me.udLocateRow.Min = 1
Me.udLocateRow.Max = frmQR.fg.Rows - 1
'自定义分组
Me.lstGroupAll.Clear
If frmQR.fg.Cols > 1 Then
For i = 1 To frmQR.fg.Cols - 1
strTemp = ""
strTemp = Trim(frmQR.fg.Cell(flexcpText, frmQR.fg.FixedRows - 1, i))
strTemp = Replace(strTemp, Chr(10), "")
strTemp = Replace(strTemp, Chr(13), "")
Me.lstGroupAll.AddItem frmQR.fg.ColKey(i) & " " & strTemp
Next i
End If
'表格运算
Me.cboAggregateFunction.Clear
With Me.cboAggregateFunction
.AddItem "无"
.AddItem "求和"
.AddItem "计数"
.AddItem "均值"
.AddItem "最大值"
.AddItem "最小值"
.AddItem "标准偏差"
.AddItem "方差"
End With
Me.cboAggregateFunction.ListIndex = 0
'汇总
Me.cboSubtotalHor.Clear
With Me.cboSubtotalHor
.AddItem "无"
.AddItem "求和"
'.AddItem "计数"
.AddItem "均值"
'.AddItem "最大值"
'.AddItem "最小值"
'.AddItem "标准偏差"
'.AddItem "方差"
End With
Me.cboAggregateFunction.ListIndex = 0
Me.txtAggregateResult.Text = ""
Me.lstSubtotalHor.Clear
If frmQR.fg.Cols > 1 Then
For i = 1 To frmQR.fg.Cols - 1
strTemp = ""
strTemp = Trim(frmQR.fg.Cell(flexcpText, frmQR.fg.FixedRows - 1, i))
strTemp = Replace(strTemp, Chr(10), "")
strTemp = Replace(strTemp, Chr(13), "")
Me.lstSubtotalHor.AddItem frmQR.fg.ColKey(i) & " " & " " & strTemp
Next i
End If
Me.cboSubtotalVer.Clear
With Me.cboSubtotalVer
.AddItem "无"
.AddItem "求和"
.AddItem "计数"
.AddItem "均值"
.AddItem "百分率"
.AddItem "最大值"
.AddItem "最小值"
.AddItem "标准偏差"
.AddItem "方差"
End With
Me.lstSubtotalVer.Clear
If frmQR.fg.Cols > 1 Then
For i = 1 To frmQR.fg.Cols - 1
strTemp = ""
strTemp = Trim(frmQR.fg.Cell(flexcpText, frmQR.fg.FixedRows - 1, i))
strTemp = Replace(strTemp, Chr(10), "")
strTemp = Replace(strTemp, Chr(13), "")
Me.lstSubtotalVer.AddItem frmQR.fg.ColKey(i) & " " & " " & strTemp
Next i
End If
'列头定义
End Sub
Private Sub cboAggregateFunction_Click()
'表格运算
If frmQR.fg.Rows <= 1 Or frmQR.fg.Cols <= 1 Then
MsgBox "无计算数据！"
Exit Sub
End If
Dim r1&, c1&, r2&, c2&
Dim i&, j&
Call frmQR.fg.GetSelection(r1, c1, r2, c2)
Select Case Trim(Me.cboAggregateFunction.Text)
Case "求和"
Me.txtAggregateResult.Text = frmQR.fg.Aggregate(flexSTSum, r1, c1, r2, c2)
Case "计数"
Me.txtAggregateResult.Text = frmQR.fg.Aggregate(flexSTCount, r1, c1, r2, c2)
Case "均值"
Me.txtAggregateResult.Text = frmQR.fg.Aggregate(flexSTAverage, r1, c1, r2, c2)
Case "最大值"
Me.txtAggregateResult.Text = frmQR.fg.Aggregate(flexSTMax, r1, c1, r2, c2)
Case "最小值"
Me.txtAggregateResult.Text = frmQR.fg.Aggregate(flexSTMin, r1, c1, r2, c2)
Case "标准偏差"
Me.txtAggregateResult.Text = frmQR.fg.Aggregate(flexSTStd, r1, c1, r2, c2)
Case "方差"
Me.txtAggregateResult.Text = frmQR.fg.Aggregate(flexSTVar, r1, c1, r2, c2)
End Select
End Sub
Private Sub cboSubtotalVer_Click()
'选择纵向汇总函数
Dim arr
Dim strTemp$
If Me.lstSubtotalVer.ListIndex = -1 Then
MsgBox "请选择需汇总列!"
ElseIf Trim(Me.lstSubtotalVer.Text) <> "无" Then
strTemp = Me.lstSubtotalVer.List(Me.lstSubtotalVer.ListIndex)
arr = Split(strTemp, "||")
If Trim(Me.lstSubtotalVer.ItemData(Me.lstSubtotalVer.ListIndex)) <> 0 Then
Me.lstSubtotalVer.List(Me.lstSubtotalVer.ListIndex) = Left(strTemp, Len(strTemp) - Len(arr(UBound(arr))) - 2) & "||" & Trim(Me.cboSubtotalVer.Text)
Me.lstSubtotalVer.ItemData(Me.lstSubtotalVer.ListIndex) = 0 '表示无
Else
Me.lstSubtotalVer.List(Me.lstSubtotalVer.ListIndex) = strTemp & " " & "||" & Trim(Me.cboSubtotalVer.Text)
Me.lstSubtotalVer.ItemData(Me.lstSubtotalVer.ListIndex) = Me.cboSubtotalVer.ListIndex + 1 '从1开始标识
End If
End If
End Sub
Private Sub cmdAggregateCancel_Click()
Me.Hide
End Sub
Private Sub cmdAggregateCopy_Click()
VB.Clipboard.Clear
VB.Clipboard.SetText Me.txtAggregateResult.Text
End Sub
Private Sub cmdAggregateOK_Click()
If frmQR.fg.Rows <= 1 Or frmQR.fg.Cols <= 1 Then
MsgBox "无计算数据！"
Exit Sub
End If
Dim r1&, c1&, r2&, c2&
Dim i&, j&
Call frmQR.fg.GetSelection(r1, c1, r2, c2)
If Me.chkAggregateInsert.Value = vbChecked Then
If Trim(Me.txtAggregateResult.Text) = "" Then
If MsgBox("结果为空，要继续插入吗？", vbYesNo, "提示") = vbNo Then Me.Hide: Exit Sub
End If
If Me.optAggregateDown.Value Then
frmQR.fg.AddItem "", r2 + 1
frmQR.fg.Cell(flexcpText, r2 + 1, c2) = Me.txtAggregateResult.Text
Else
frmQR.fg.Cols = frmQR.fg.Cols + 1
frmQR.lngColKey = frmQR.lngColKey + 1
frmQR.fg.ColKey(frmQR.fg.Cols - 1) = frmQR.lngColKey
frmQR.fg.ColPosition(frmQR.fg.Cols - 1) = c2 + 1
frmQR.fg.Cell(flexcpText, r2, c2 + 1) = Me.txtAggregateResult.Text
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?