以下程式是小弟將 "CWW的VB心得筆記"中的一段修改的,但是確發生了只要連接資料庫且資料庫中無資料,用滑鼠點欄位Row1 時無任何動作,不知那位先進能幫小弟解決.....
程式如下:
Option Explicit
Private OldText As String
Private ColSelect() As Boolean
Private SaveCellBkColor As Long
Private Sub Form_Load()
Text1.Visible = False
Me.Show
With MSFlexGrid1
.Cols = 10
.Rows = 15
ReDim ColSelect(1 To .Cols - 1)
SaveCellBkColor = .CellBackColor
Call InitGrid
.AllowBigSelection = True
.FillStyle = flexFillRepeat
'.AllowUserResizing = True '請事先設好
Dim i As Variant
For i = 1 To .Cols
.ColWidth(i) = 1000
Next
End With
End Sub
Private 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 Boolean
Call 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 Sub
Private 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
Dim i As Variant
For i = 0 To .Cols
.ColWidth(i) = 1000
Next
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
Text1.BackColor = &H80FF80
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
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 Sub
Private Sub MSFlexGrid1_Scroll()
SendKeys "{ESC}"
End Sub