Private Sub msgDeliver_EnterCell() With Text_word 'TEXTBOX控件 .Top = msgDeliver.Top + msgDeliver.CellTop .Left = msgDeliver.Left + msgDeliver.CellLeft .Width = msgDeliver.CellWidth .Height = msgDeliver.CellHeight .Text = msgDeliver.Text .Visible = True .SetFocus .SelStart = 0 .SelLength = Len(Text_word) End With END SUB
Option Explicit Private OldText As String Private ColSelect() As Boolean Private SaveCellBkColor As LongPrivate Sub Form_Load() Text1.Visible = False Me.Show With MSFlexGrid1 .Cols = 5 .Rows = 15 ReDim ColSelect(1 To .Cols - 1) SaveCellBkColor = .CellBackColor Call InitGrid .AllowBigSelection = True .FillStyle = flexFillRepeat '.AllowUserResizing = True '请事先设好 End With End SubPrivate Sub InitGrid() Dim i As Long With MSFlexGrid1 .Row = 0 For i = 1 To .Cols - 1 .Col = i: .Text = "Col" + Format(i, "00") '若Cols超出99,则修改Format Next '的格式 End With With MSFlexGrid1 .Col = 0 For i = 1 To .Rows - 1 .Row = i: .Text = i Next End With 'Dim width5 As Long 'With MSFlexGrid1 ' width5 = .Width \ .Cols ' For i = 0 To .Cols - 1 ' .ColWidth(i) = width5 ' Next 'End With End Sub Private Sub MSFlexGrid1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) Dim inMostLeft As Boolean Dim inMostTop As BooleanCall ProcMultiColSel(Shift) With MSFlexGrid1 If Button = vbKeyRButton Then '按mouse 右键且位於最上列/最左行则是更动title If .MouseCol = 0 Or .MouseRow = 0 Then Call toEditGrid(.MouseCol, .MouseRow) End If Else If Button = vbKeyLButton Then If .ColSel = .Col And .RowSel = .Row Then '表示没有多个栏位的选取,这时才真正是可以输入 Call toEditGrid(.Col, .Row) End If End If End If End With End Sub Private Sub MSFlexGrid1_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn And Not Text1.Visible Then With MSFlexGrid1 Call toEditGrid(.Col, .Row) End With End If End Sub 'TextBox上的输入反映到MsFlexGrid上 Private Sub Text1_Change() MSFlexGrid1.Text = Text1.Text End Sub '按下Down/Up 时结束TextBox的Keyin Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyUp Then Text1.Visible = False MSFlexGrid1.SetFocus SendKeys "{up}" Else If KeyCode = vbKeyDown Then Text1.Visible = False MSFlexGrid1.SetFocus SendKeys "{down}" End If End If End Sub Private Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii = vbKeyReturn Then KeyAscii = 0 Text1.Visible = False MSFlexGrid1.SetFocus End If If KeyAscii = vbKeyEscape Then KeyAscii = 0 MSFlexGrid1.Text = OldText Text1.Visible = False MSFlexGrid1.SetFocus End If End SubPrivate Sub Text1_LostFocus() Text1.Visible = False End Sub '设定TextBox於MSFlexGrid1的Current Cell上 Private Sub toEditGrid(ByVal C As Integer, ByVal R As Integer) With MSFlexGrid1 .Col = C: .Row = R Text1.Left = .Left + .ColPos(C) Text1.Top = .Top + .RowPos(R) If .Appearance = flex3D Then Text1.Left = Text1.Left + 2 * Screen.TwipsPerPixelX Text1.Top = Text1.Top + 2 * Screen.TwipsPerPixelY End If Text1.Width = .ColWidth(C) Text1.Height = .RowHeight(R) Text1.Text = .Text OldText = .Text End With Text1.Visible = True Text1.SelStart = Len(Text1.Text) Text1.SetFocus End Sub '以下程式处理Multi-column Selection的问题 Private Sub ProcMultiColSel(ByVal Shift As Integer) Dim i As Long, HaveSel As Boolean Dim SelSt As Long, SelEnd As Long Dim OldRowSel As Long, OldColSel As Long With MSFlexGrid1 OldRowSel = .RowSel: OldColSel = .ColSel If HaveSelEntireCol Then '如果有整行被选取的清况,则计算选取的起始结束行 SelSt = IIf(.Col <= .ColSel, .Col, .ColSel) SelEnd = IIf(.Col > .ColSel, .Col, .ColSel) For i = SelSt To SelEnd ColSelect(i) = True Next .CellBackColor = .BackColorSel If Shift <> vbCtrlMask Then '没有按Ctl键则清除其他Column的Selection Call RefreshCols(SelSt, SelEnd) End If Else HaveSel = False For i = 1 To .Cols - 1 HaveSel = HaveSel Or ColSelect(i) Next If HaveSel Then Call RefreshAll End If End If .RowSel = OldRowSel .ColSel = OldColSel End With End Sub 'Check是否有整行的选取 Private Function HaveSelEntireCol() As Boolean With MSFlexGrid1 If .RowSel = (.Rows - 1) And .Row = 1 Then HaveSelEntireCol = True Else HaveSelEntireCol = False End If End With End Function '清除所有的Selection Private Sub RefreshAll() Dim SaveCol As Long, SaveRow As Long, i As Long With MSFlexGrid1 SaveCol = .Col: SaveRow = .Row .Col = 1: .Row = 1 .ColSel = .Cols - 1: .RowSel = .Rows - 1 MSFlexGrid1.CellBackColor = SaveCellBkColor .Col = SaveCol: .Row = SaveRow .ColSel = SaveCol: .RowSel = SaveRow For i = 1 To .Cols - 1 ColSelect(i) = False Next End With End Sub '清除其他Column的Selection除了columns From Selst to SelEnd外,其他清除 Private Sub RefreshCols(ByVal SelSt As Long, ByVal SelEnd As Long) Dim SaveCol As Long, SaveRow As Long, i As Long With MSFlexGrid1 SaveCol = .Col: SaveRow = .Row For i = 1 To .Cols - 1 If Not (i >= SelSt And i <= SelEnd) And ColSelect(i) Then .Col = i: .Row = 1 .ColSel = i: .RowSel = .Rows - 1 MSFlexGrid1.CellBackColor = SaveCellBkColor ColSelect(i) = False End If Next .Col = SaveCol: .Row = SaveRow .ColSel = SaveCol: .RowSel = SaveRow End With End SubPrivate Sub MSFlexGrid1_Scroll() SendKeys "{ESC}" End Sub
Private Sub MSFlexGrid1_Click() txtcontrol.Text = MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, MSFlexGrid1.Col)
我有一份修改后的范例,实现功能如下:
1.在MSFlexGrid上按Enter时,可以编修当格(Current Cell)的内容
2.在MSFlexGrid上Click时,可以编修当格(Current Cell)的内容
3.在MSFlexGrid上固定列与固定行上面按Mouse右键时可以修改其Title
4.允许MultiLine/MultiCol的Selection 与按Ctl-Mouse左键的 MultiSelect Columns
5.进入Cell的EditMode时,按up/Down键会离开Current Cell而进入上/下 一行的Cell
6.进入Cell的EditMode时,按Escape回覆原本的字串要不要?
我有一份修改后的范例,实现功能如下:
1.在MSFlexGrid上按Enter时,可以编修当格(Current Cell)的内容
2.在MSFlexGrid上Click时,可以编修当格(Current Cell)的内容
3.在MSFlexGrid上固定列与固定行上面按Mouse右键时可以修改其Title
4.允许MultiLine/MultiCol的Selection 与按Ctl-Mouse左键的 MultiSelect Columns
5.进入Cell的EditMode时,按up/Down键会离开Current Cell而进入上/下 一行的Cell
6.进入Cell的EditMode时,按Escape回覆原本的字串要不要?
贴出来看看,谢了!
'txtControl 是 textbox控件
If msflexgrid1.Col <> 1 Then 假如第一列要显示txtControl则<>1
txtControl.Visible = False
Exit Sub
Else
txtControl.Text = msflexgrid1.TextMatrix(msflexgrid1.row, msflexgrid1.Col)
With msflexgrid1
.RowSel = .row
.ColSel = .Col
'下面是把文本框 cbocontrol 移到当前单元格
txtControl.Move .Left + .CellLeft, .Top + .CellTop, _
.CellWidth - ScaleX(1, vbPixels, vbTwips)
txtControl.Visible = True
txtControl.ZOrder
txtControl.SetFocus
txtControl.BackColor = &HE0E0E0
txtControl.SelLength = Len(CboControl.Text)
' txtControl.Text = .TextMatrix(.row, .Col)
End With
End If
End SubPrivate Sub txtControl_Change()
'将下拉列表框信息写入表格中 If Trim(txtControl.Text) = "" Then Exit Sub
msflexgrid1.TextMatrix(msflexgrid1.row, msflexgrid1.Col) = Trim(txtControl.Text)
msflexgrid1.CellBackColor = &HFFFFFF
End Sub
With Text_word 'TEXTBOX控件
.Top = msgDeliver.Top + msgDeliver.CellTop
.Left = msgDeliver.Left + msgDeliver.CellLeft
.Width = msgDeliver.CellWidth
.Height = msgDeliver.CellHeight
.Text = msgDeliver.Text
.Visible = True
.SetFocus
.SelStart = 0
.SelLength = Len(Text_word)
End With
END SUB
Private OldText As String
Private ColSelect() As Boolean
Private SaveCellBkColor As LongPrivate Sub Form_Load()
Text1.Visible = False
Me.Show
With MSFlexGrid1
.Cols = 5
.Rows = 15
ReDim ColSelect(1 To .Cols - 1)
SaveCellBkColor = .CellBackColor
Call InitGrid
.AllowBigSelection = True
.FillStyle = flexFillRepeat
'.AllowUserResizing = True '请事先设好
End With
End SubPrivate Sub InitGrid()
Dim i As Long
With MSFlexGrid1
.Row = 0
For i = 1 To .Cols - 1
.Col = i: .Text = "Col" + Format(i, "00") '若Cols超出99,则修改Format
Next '的格式
End With
With MSFlexGrid1
.Col = 0
For i = 1 To .Rows - 1
.Row = i: .Text = i
Next
End With
'Dim width5 As Long
'With MSFlexGrid1
' width5 = .Width \ .Cols
' For i = 0 To .Cols - 1
' .ColWidth(i) = width5
' Next
'End With
End Sub
Private Sub MSFlexGrid1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim inMostLeft As Boolean
Dim inMostTop As BooleanCall ProcMultiColSel(Shift)
With MSFlexGrid1
If Button = vbKeyRButton Then
'按mouse 右键且位於最上列/最左行则是更动title
If .MouseCol = 0 Or .MouseRow = 0 Then
Call toEditGrid(.MouseCol, .MouseRow)
End If
Else
If Button = vbKeyLButton Then
If .ColSel = .Col And .RowSel = .Row Then
'表示没有多个栏位的选取,这时才真正是可以输入
Call toEditGrid(.Col, .Row)
End If
End If
End If
End With
End Sub
Private Sub MSFlexGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn And Not Text1.Visible Then
With MSFlexGrid1
Call toEditGrid(.Col, .Row)
End With
End If
End Sub
'TextBox上的输入反映到MsFlexGrid上
Private Sub Text1_Change()
MSFlexGrid1.Text = Text1.Text
End Sub
'按下Down/Up 时结束TextBox的Keyin
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyUp Then
Text1.Visible = False
MSFlexGrid1.SetFocus
SendKeys "{up}"
Else
If KeyCode = vbKeyDown Then
Text1.Visible = False
MSFlexGrid1.SetFocus
SendKeys "{down}"
End If
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
KeyAscii = 0
Text1.Visible = False
MSFlexGrid1.SetFocus
End If
If KeyAscii = vbKeyEscape Then
KeyAscii = 0
MSFlexGrid1.Text = OldText
Text1.Visible = False
MSFlexGrid1.SetFocus
End If
End SubPrivate Sub Text1_LostFocus()
Text1.Visible = False
End Sub
'设定TextBox於MSFlexGrid1的Current Cell上
Private Sub toEditGrid(ByVal C As Integer, ByVal R As Integer)
With MSFlexGrid1
.Col = C: .Row = R
Text1.Left = .Left + .ColPos(C)
Text1.Top = .Top + .RowPos(R)
If .Appearance = flex3D Then
Text1.Left = Text1.Left + 2 * Screen.TwipsPerPixelX
Text1.Top = Text1.Top + 2 * Screen.TwipsPerPixelY
End If
Text1.Width = .ColWidth(C)
Text1.Height = .RowHeight(R)
Text1.Text = .Text
OldText = .Text
End With
Text1.Visible = True
Text1.SelStart = Len(Text1.Text)
Text1.SetFocus
End Sub
'以下程式处理Multi-column Selection的问题
Private Sub ProcMultiColSel(ByVal Shift As Integer)
Dim i As Long, HaveSel As Boolean
Dim SelSt As Long, SelEnd As Long
Dim OldRowSel As Long, OldColSel As Long
With MSFlexGrid1
OldRowSel = .RowSel: OldColSel = .ColSel
If HaveSelEntireCol Then
'如果有整行被选取的清况,则计算选取的起始结束行
SelSt = IIf(.Col <= .ColSel, .Col, .ColSel)
SelEnd = IIf(.Col > .ColSel, .Col, .ColSel)
For i = SelSt To SelEnd
ColSelect(i) = True
Next
.CellBackColor = .BackColorSel
If Shift <> vbCtrlMask Then '没有按Ctl键则清除其他Column的Selection
Call RefreshCols(SelSt, SelEnd)
End If
Else
HaveSel = False
For i = 1 To .Cols - 1
HaveSel = HaveSel Or ColSelect(i)
Next
If HaveSel Then
Call RefreshAll
End If
End If
.RowSel = OldRowSel
.ColSel = OldColSel
End With
End Sub
'Check是否有整行的选取
Private Function HaveSelEntireCol() As Boolean
With MSFlexGrid1
If .RowSel = (.Rows - 1) And .Row = 1 Then
HaveSelEntireCol = True
Else
HaveSelEntireCol = False
End If
End With
End Function
'清除所有的Selection
Private Sub RefreshAll()
Dim SaveCol As Long, SaveRow As Long, i As Long
With MSFlexGrid1
SaveCol = .Col: SaveRow = .Row
.Col = 1: .Row = 1
.ColSel = .Cols - 1: .RowSel = .Rows - 1
MSFlexGrid1.CellBackColor = SaveCellBkColor
.Col = SaveCol: .Row = SaveRow
.ColSel = SaveCol: .RowSel = SaveRow
For i = 1 To .Cols - 1
ColSelect(i) = False
Next
End With
End Sub
'清除其他Column的Selection除了columns From Selst to SelEnd外,其他清除
Private Sub RefreshCols(ByVal SelSt As Long, ByVal SelEnd As Long)
Dim SaveCol As Long, SaveRow As Long, i As Long
With MSFlexGrid1
SaveCol = .Col: SaveRow = .Row
For i = 1 To .Cols - 1
If Not (i >= SelSt And i <= SelEnd) And ColSelect(i) Then
.Col = i: .Row = 1
.ColSel = i: .RowSel = .Rows - 1
MSFlexGrid1.CellBackColor = SaveCellBkColor
ColSelect(i) = False
End If
Next
.Col = SaveCol: .Row = SaveRow
.ColSel = SaveCol: .RowSel = SaveRow
End With
End SubPrivate Sub MSFlexGrid1_Scroll()
SendKeys "{ESC}"
End Sub
txtcontrol.Text = MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, MSFlexGrid1.Col)
With MSFlexGrid1
.RowSel = .Row
.ColSel = .Col
'下面是把文本框 txtcontrol 移到当前单元格
txtcontrol.Move .Left + .CellLeft, .Top + .CellTop, _
.CellWidth - ScaleX(1, vbPixels, vbTwips)
txtcontrol.Visible = True
txtcontrol.ZOrder
txtcontrol.SetFocus
txtcontrol.BackColor = &HE0E0E0
txtcontrol.SelLength = Len(txtcontrol.Text)
End WithEnd SubPrivate Sub txtcontrol_Change()
If Trim(txtcontrol.Text) = "" Then Exit Sub
MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, MSFlexGrid1.Col) = Trim(txtcontrol.Text)
MSFlexGrid1.CellBackColor = &HFFFFFF
End Sub
你的东东我试了,不错!再次谢了