1. 直接將查詢數(shù)據(jù)填入MSHFLEXGRID
Sub QueryFromSybasebyCon(Condition)
With QEvent ‘ QEvent為Form名稱
Con.Open strConnRemote
rs.CursorLocation = adUseClient
rs.CursorType = adOpenKeyset
On Error Resume Next
Rs.Open "select * where" & Condition & " order by event_ts", Con, 3, 1 ‘Condition為SQL查詢條件
.MSHFlexGrid1.Redraw = False ‘重繪，可大大提高Grid的格式化后顯示速度
Set .MSHFlexGrid1.DataSource Rs
Set Rs = Nothing
Set Con = Nothing
End With
End Sub
2. 設置MSHFlexGrid的格式
Sub FormatFlexGrid()
With QEvent.MSHFlexGrid1
If .Rows > 1 And .TextMatrix(1, 1) <> "" Then
'Set Column width
.ColWidth(0) = 3000
'Set Column header
.TextMatrix(0, 0) = "Test"
‘設置對齊
.ColAlignment(5) = flexAlignRightCenter
End If
‘設置整行的顏色
.Redraw = False
.Row = 3
.Col = 0
.ColSel = .Cols - 1
.CellBackColor = RGB(254, 216, 209)
.Redraw = True
End With
End Sub
3. 支持滾輪事件
‘模塊部分
Public Cn As New ADODB.Connection
Public Const GWL_WNDPROC = (-4)
Public Const WM_COMMAND = &H111
Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_MOUSEWHEEL = &H20A
Public Oldwinproc As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
‘支持鼠標動作的函數(shù)
Public Function FlexScroll(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case wMsg
Case WM_MOUSEWHEEL
Select Case wParam
Case -7864320 '向下滾動
SendKeys "{PGDN}"
Case 7864320 '向上滾動
SendKeys "{PGUP}"
End Select
End Select
FlexScroll = CallWindowProc(Oldwinproc, hwnd, wMsg, wParam, lParam)
End Function
‘窗體中的程序
Private Sub MSHFlexGrid1_GotFocus()
Oldwinproc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
SetWindowLong Me.hwnd, GWL_WNDPROC, AddressOf FlexScroll
End Sub
Private Sub MSHFlexGrid1_LostFocus()
SetWindowLong Me.hwnd, GWL_WNDPROC, Oldwinproc
End Sub
4. 支持鍵盤事件
Private Sub MSHFlexGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
Dim X As Long
Dim Y As Long
Dim L As Long
Dim Tmp As String
X = MSHFlexGrid1.Col
Y = MSHFlexGrid1.Row
Select Case KeyCode '功能或擴展
Case 46 ‘響應刪除Delete鍵
MSHFlexGrid1.Text = ""
Case vbKeyC '響應Ctrl+C 復制功能
Clipboard.Clear
Call ExportExcelclip(QEvent.MSHFlexGrid1)
End Select
End Sub
Function ExportExcelclip(FLex As MSHFlexGrid)
'------------------------------------------------
‘將表中內(nèi)容復制到剪貼板
' [Scols]................復制的起始列
' [Srows]............... 復制的起始行
' [Ecols]................ 復制的結束列
' [Erows]............... 復制的結束行
'------------------------------------------------
Screen.MousePointer = 13
'
Dim Scols, Srows, Ecols, Erows As Integer
With FLex
Scols = .Col
Srows = .Row
Ecols = .ColSel
Erows = .RowSel
If .ColSel > .Col And .RowSel > .Row Then
Scols = .Col
Srows = .Row
Ecols = .ColSel
Erows = .RowSel
ElseIf .ColSel < .Col And .RowSel < .Row Then
Scols = .ColSel
Srows = .RowSel
Ecols = .Col
Erows = .Row
ElseIf .ColSel > .Col And .RowSel < .Row Then
Scols = .Col
Srows = .RowSel
Ecols = .ColSel
Erows = .Row
ElseIf .ColSel < .Col And .RowSel > .Row Then
Scols = .ColSel
Srows = .Row
Ecols = .Col
Erows = .RowSel
End If
If .Col = 1 And .Row = 1 Then
Scols = 0
Srows = 0
End If
End With
Dim i, J As Integer
Dim str As String
Dim Fileopens As Boolean
On Error GoTo err
str = ""
If Srows = 0 Then
For i = Scols To Ecols '復制表頭
If i = Scols Then
' str = str & FLex.TextMatrix(0, i)
Else
str = str & Chr(9) & FLex.TextMatrix(0, i)
End If
Next
End If
For J = Srows To Erows
If J >= 1 Then
For i = Scols To Ecols
If i = Scols Then
Else
str = str & Chr(9) & FLex.TextMatrix(J, i)
End If
Next
str = str & vbCrLf
End If
Next
Clipboard.Clear ' 清除剪貼板
Clipboard.SetText str ' 將正文放在剪貼板上
Screen.MousePointer = 0
err:
Select Case err.Number
Case 0
Case Else
Screen.MousePointer = 0
MsgBox err.Description, vbInformation, "復制出錯"
Exit Function
End Select
End Function
5. 打印MSHFLEXGRID
Sub InitPrint() ‘初始化打印機
Printer.Orientation = 2 ‘橫向為2，縱向為1
Printer.ScaleMode = 6 ‘以mm為單位
Printer.ScaleLeft = 30 '左邊界
Printer.ScaleTop = 30 ‘上邊界
Printer.ScaleHeight = 300 ‘設定高度
Printer.ScaleWidth = 200 ‘設置寬度
End Sub
Sub PrintMSHGrid(FlexGrid As MSHFlexGrid)
InitPrint
FlexGrid.Parent.PrintForm
Printer.EndDoc
End Sub
6. MSHFLEXGRID的輸出
Public Sub OutDataToText(FLex As MSHFlexGrid) ‘輸出到TXT文本
Dim s As String
Dim i As Integer
Dim J As Integer
Dim k As Integer
Dim strTemp As String
Dim Fname As String
If FLex.Rows > 2 Then
If FLex.Parent.Name = "WebData" Then Fname = "myfilename-" & WebData.SelNode & ".txt"
'檢查并創(chuàng)建臨時文件夾
Call CheckPath
On Error Resume Next
DoEvents
Dim FileNum As Integer
FileNum = FreeFile
Open App.Path & "\Temp\" & Fname For Output As #FileNum
With FLex
k = .Rows
For i = 0 To k - 1
strTemp = ""
For J = 0 To .Cols - 1
DoEvents
strTemp = strTemp & .TextMatrix(i, J) & ","
Next J
Print #FileNum, Left(strTemp, Len(strTemp) - 1)
Next i
End With
Close #FileNum
MsgBox “保存成功!文件名為" & Fname & vbCrLf & "保存路徑為:" & vbCrLf & App.Path & "\Temp"
Else
MsgBox "無數(shù)據(jù)，請檢查"
End If
End Sub
Sub ExporToExcel(FLex As MSHFlexGrid) ‘輸出到Excel
Dim xlapp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
With FLex
If .Rows > 2 Then
If FLex.Parent.Name = "WebData" Then Fname = "Myfilename-" & WebData.SelNode & ".xls"
Call CheckPath
Set xlapp = CreateObject("Excel.Application") '創(chuàng)建Excel對象
xlapp.Application.Visible = False
On Error Resume Next
Set xlbook = xlapp.Workbooks.Add
'設定單元格格式
With xlbook.Worksheets(1)
.Name = Fname
.Range("A1:M1").Font.Color = vbBlue
.Range("A1:M1").Font.Bold = True
Columns("A:M").EntireColumn.AutoFit
End With
'開始傳輸數(shù)據(jù)
k = 0
For i = 0 To .Rows - 1
For J = 0 To .Cols - 1
xlbook.Worksheets(1).Cells(i + 1, J + 1) = .TextMatrix(i, J)
Next J
Next i
xlbook.Worksheets(1).Columns("A:M").EntireColumn.AutoFit
xlbook.SaveAs App.Path & "\Temp\" & Fname
xlbook.Application.Quit
Set xlbook = Nothing
MsgBox “保存成功!文件名為" & Fname & vbCrLf & "保存路徑為:" & vbCrLf & App.Path & "\Temp"
Else
MsgBox "無數(shù)據(jù)，請檢查"
End If
End With
End Sub
Sub CheckPath()
If Dir(App.Path & "\Temp", vbDirectory) = "" Then
MkDir App.Path & "\Temp"
End If
End Sub
