|
楼主 |
发表于 2018-12-31 23:58
|
显示全部楼层
2.9 复制、粘贴、清除内容、删除行和插入行
这些功能网格控件都已提供,无需编写代码,我把这些功能做成右键菜单,方便使用。右键菜单的代码如下:
Sub PopupMenu()
On Error Resume Next
CommandBars("PopupMenu").Delete
With CommandBars.Add("PopupMenu", msoBarPopup, , True)
With .Controls.Add(msoControlButton)
.Caption = "复制[&C]"
.OnAction = "复制"
.FaceId = 19
End With
With .Controls.Add(msoControlButton)
.Caption = "清除[&R]"
.OnAction = "清除"
.FaceId = 47
End With
With .Controls.Add(msoControlButton)
.Caption = "剪切[&T]"
.OnAction = "剪切"
.FaceId = 21
End With
With .Controls.Add(msoControlButton)
.Caption = "粘贴[&P]"
.OnAction = "粘贴"
.FaceId = 22
End With
With .Controls.Add(msoControlButton)
.Caption = "插入行[&I]"
.OnAction = "插入行"
.FaceId = 137
.BeginGroup = True
End With
With .Controls.Add(msoControlButton)
.Caption = "删除行[&D]"
.OnAction = "删除行"
.FaceId = 478
End With
End With
End Sub
Sub 复制() '复制选择区域、整行或整列文本
UserForm1.fg.Copy
End Sub
Sub 粘贴() '粘贴,可根据剪贴板数据自适应目标区域
UserForm1.fg.Paste
End Sub
Sub 清除() '清除选择区域、整行或整列文本
'fg.Clear flexClearSelection, flexClearText
UserForm1.fg.Delete '两者都可以用
End Sub
Sub 剪切() '剪切选择区域、整行或整列文本
UserForm1.fg.Cut
End Sub
Sub 插入行() '在当前行之前插入任意行(选中多少行插入多少行)
With UserForm1.fg
Dim r&, p&
p = Application.Min(.Row, .RowSel)
For r = 1 To Abs(.Row - .RowSel) + 1
.AddItem "", p
Next
End With
End Sub
Sub 删除行() '删除当前选择的所有行
With UserForm1.fg
Dim r&, r1&, c1&, r2&, c2&
.GetSelection r1, c1, r2, c2
For r = r2 To r1 Step -1:
.RemoveItem r
Next
End With
End Sub
窗体中的代码为,注意窗体初始化时调用PopupMenu:
Private Sub UserForm_Initialize()
fg.Rows = 20
For i = 1 To fg.Rows - 1
fg.TextMatrix(i, 1) = "test" & i
fg.TextMatrix(i, 2) = Rnd() * 10000
Next
fg.Editable = flexEDKbdMouse
PopupMenu
End Sub
Private Sub fg_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then CommandBars("PopupMenu").ShowPopup
End Sub
需要注意的是,如果你不希望鼠标在列0或行0也启动鼠标右键,可以修改事件过程:
Private Sub fg_BeforeMouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single, Cancel As Boolean)
If Button = 2 Then
If fg.MouseCol = 0 Or fg.MouseRow = 0 Then
Cancel = True
Else
CommandBars("PopupMenu").ShowPopup
End If
End If
End Sub
BeforeMouseDown事件发生在MouseDown之前。.MouseRow和MouseCol属性返回鼠标指针下面的行、列基于零的索引。最后得到的效果如下:
图13
2.10 合并单元格做出复杂表头
如果需要合并单元格制作复杂的表头,可MergeCells、MergeRow、MergeCol和MergeCompare四个属性一起使用。若要创建具有合并单元格的表,必须将MergeCell设置为flexMergeNever以外的值,然后将MergeRow和MergeCol属性设置为true,以用于希望合并的行和列(除非使用flexMergeSpill模式时)。在设置这些属性之后,控制将自动合并具有相同内容的相邻单元格。每当单元格内容发生变化时,控件就更新合并状态。用于比较单元格内容并决定它们是否应该合并的算法通过MergeCompare属性设置。
MergeCells返回或设置是否具有相同内容的单元格将合并到单个单元格中。MergeCells属性的设置如下:
常数 值 描述
flexMergeNever 0 不合并单元格。
flexMergeFree 1 合并具有相同内容的任何相邻单元格(如果它们位于RowMerge设置为True的行或MergeCol设置为True的列上)。
flexMergeRestrictRows 2 只有在上边的单元格也被合并时才合并行。
flexMergeRestrictColumns 3 只有在左边的单元格也被合并时才合并列。
flexMergeRestrictAll 4 只有在上边或左边的单元格也被合并时,才合并单元格。
flexMergeFixedOnly 5 只合并固定单元。此设置用于为数据设置复杂的表头并防止数据本身被合并。
flexMergeSpill 6 允许长条目溢出到相邻空单元格中。
flexMergeOutline 7 允许小计行(大纲节点)中的条目溢出到相邻空单元格中。
表11
flexMergeSpill设置与其他设置稍有不同。这是唯一不需要设置MergeCol和MergeRow属性的设置,并且不会将具有相同设置的单元格合并。相反,它允许具有长条目的单元格溢出到相邻单元格中,只要它们是空的。
MergeRow返回或设置某行是否合并单元格,而MergeCol返回或设置某列是否合并单元格,-1设置所有行或列。MergeCompare属性返回或设置合并单元格时使用的比较类型,其设置如下:
常数 值 描述
FlexMCExact 0 只有当单元格的内容完全匹配时才合并。
FlexMCNoCase 1 不区分大小写条件下单元格中的内容匹配,则合并单元格。
FlexMCTrimNoCase 2 不区分大小写条件下单元格中的内容剔除空白符后匹配,则合并单元格。
FlexMCIncludeNulls 3 合并空单元格。
表12
因为合并单元格并不复杂,只要让要合并的单元格具有相同的值,网格控件会自动合并单元格。这里提供一个成绩表的合并表头作为参考:
Private Sub UserForm_Initialize()
fg.Rows = 99
fg.Cols = 10
fg.FixedRows = 2
fg.Cell(flexcpText, 0, 1, 1, 1) = "学生姓名"
fg.Cell(flexcpText, 0, 2, 0, 9) = "课程成绩"
fg.TextMatrix(1, 2) = "语文"
fg.TextMatrix(1, 3) = "数学"
fg.TextMatrix(1, 4) = "英语"
fg.TextMatrix(1, 5) = "物理"
fg.TextMatrix(1, 6) = "化学"
fg.TextMatrix(1, 7) = "地理"
fg.TextMatrix(1, 8) = "生物"
fg.TextMatrix(1, 9) = "思品"
fg.FixedAlignment(-1) = flexAlignCenterCenter
fg.ForeColorFixed = vbBlue
fg.MergeCells = flexMergeFixedOnly
fg.MergeCol(-1) = True
fg.MergeRow(-1) = True
fg.AutoSize 0
fg.Editable = flexEDKbdMouse
End Sub
运行以上代码,得到的效果如下图:
图14
|
|