VB-MSHFlexGrid常用的功能代码

VB 前端之家
前端之家收集整理的这篇文章主要介绍了VB-MSHFlexGrid常用的功能代码，前端之家小编觉得挺不错的，现在分享给大家，也给大家做个参考。

1. 直接将查询数据填入MSHFLEXGRID

@H_403_7@Sub QueryFromSybasebyCon(Condition)

@H_403_7@With QEvent ‘ QEvent为Form名称

@H_403_7@ Con.Open strConnRemote

@H_403_7@ rs.CursorLocation = adUseClient

@H_403_7@ rs.CursorType = adOpenKeyset

@H_403_7@ On Error Resume Next

@H_403_7@ Rs.Open "select * where" & Condition & " order by event_ts",Con,3,1 ‘Condition为sql查询条件

@H_403_7@ .MSHFlexGrid1.Redraw = False ‘@H_403_7@重绘，可大大提高@H_403_7@Grid@H_403_7@的格式化后显示速度

@H_403_7@ Set .MSHFlexGrid1.DataSource Rs

@H_403_7@ Set Rs = Nothing

@H_403_7@ Set Con = Nothing

@H_403_7@End With

@H_403_7@End Sub

@H_403_7@2. @H_403_7@设置@H_403_7@MSHFlexGrid@H_403_7@的格式

@H_403_7@Sub FormatFlexGrid()

@H_403_7@ With QEvent.MSHFlexGrid1

@H_403_7@ If .Rows > 1 And .TextMatrix(1,1) <> "" Then

'Set Column width

@H_403_7@ .ColWidth(0) = 3000

'Set Column header

@H_403_7@ .TextMatrix(0,0) = "Test"

‘设置对齐

@H_403_7@ .ColAlignment(5) = flexAlignRightCenter

@H_403_7@ End If

@H_403_7@ ‘设置整行的颜色

@H_403_7@ .Redraw = False

@H_403_7@ .Row = 3

@H_403_7@ .Col = 0

@H_403_7@ .ColSel = .Cols - 1

@H_403_7@ .CellBackColor = RGB(254,216,209)

@H_403_7@ .Redraw = True

@H_403_7@ End With

@H_403_7@End Sub

@H_403_7@3. @H_403_7@支持滚轮事件

‘模块部分

@H_403_7@Public Cn As New ADODB.Connection

@H_403_7@Public Const GWL_WNDPROC = (-4)

@H_403_7@Public Const WM_COMMAND = &H111

@H_403_7@Public Const WM_MBUTTONDOWN = &H207

@H_403_7@Public Const WM_MBUTTONUP = &H208

@H_403_7@Public Const WM_MOUSEWHEEL = &H20A

@H_403_7@Public Oldwinproc As Long

@H_403_7@Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long,_

@H_403_7@ ByVal nIndex As Long,ByVal dwNewLong As Long) As Long

@H_403_7@

@H_403_7@Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long,_

@H_403_7@ByVal hwnd As Long,ByVal Msg As Long,ByVal wParam As Long,ByVal lParam As Long) As Long

@H_403_7@

@H_403_7@Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long,_

@H_403_7@ ByVal nIndex As Long) As Long

@H_403_7@

@H_403_7@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

‘支持鼠标动作的函数

@H_403_7@ Public Function FlexScroll(ByVal hwnd As Long,ByVal wMsg As Long,ByVal lParam As Long) As Long

@H_403_7@ Select Case wMsg

@H_403_7@ Case WM_MOUSEWHEEL

@H_403_7@ Select Case wParam

@H_403_7@ Case -7864320 '@H_403_7@向下滚动

@H_403_7@ SendKeys "{PGDN}"

@H_403_7@

@H_403_7@ Case 7864320 '@H_403_7@向上滚动

@H_403_7@ SendKeys "{PGUP}"

@H_403_7@ End Select

@H_403_7@ End Select

@H_403_7@ FlexScroll = CallWindowProc(Oldwinproc,hwnd,wMsg,wParam,lParam)

@H_403_7@End Function

‘窗体中的程序

@H_403_7@ Private Sub MSHFlexGrid1_GotFocus()

@H_403_7@ Oldwinproc = GetWindowLong(Me.hwnd,GWL_WNDPROC)

@H_403_7@ SetWindowLong Me.hwnd,GWL_WNDPROC,AddressOf FlexScroll

@H_403_7@ End Sub

@H_403_7@ Private Sub MSHFlexGrid1_LostFocus()

@H_403_7@ SetWindowLong Me.hwnd,Oldwinproc

@H_403_7@ End Sub

@H_403_7@

@H_403_7@4. @H_403_7@支持键盘事件

@H_403_7@ Private Sub MSHFlexGrid1_KeyDown(KeyCode As Integer,Shift As Integer)

@H_403_7@Dim X As Long

@H_403_7@Dim Y As Long

@H_403_7@Dim L As Long

@H_403_7@Dim Tmp As String

@H_403_7@X = MSHFlexGrid1.Col

@H_403_7@Y = MSHFlexGrid1.Row

@H_403_7@Select Case KeyCode '@H_403_7@功能或扩展

@H_403_7@ Case 46 ‘@H_403_7@响应删除@H_403_7@Delete@H_403_7@键

@H_403_7@ MSHFlexGrid1.Text = ""

@H_403_7@Case vbKeyC '@H_403_7@响应@H_403_7@Ctrl+C @H_403_7@复制功能@H_403_7@

@H_403_7@ Clipboard.Clear

@H_403_7@ Call ExportExcelclip(QEvent.MSHFlexGrid1)

@H_403_7@End Select

@H_403_7@End Sub

@H_403_7@Function ExportExcelclip(FLex As MSHFlexGrid)

@H_403_7@'------------------------------------------------

@H_403_7@‘@H_403_7@将表中内容复制到剪贴板

@H_403_7@' [Scols]................@H_403_7@复制的起始列

@H_403_7@' [Srows]............... @H_403_7@复制的起始行

@H_403_7@' [Ecols]................ @H_403_7@复制的结束列

@H_403_7@' [Erows]............... @H_403_7@复制的结束行

@H_403_7@'------------------------------------------------

@H_403_7@Screen.MousePointer = 13

@H_403_7@'

@H_403_7@ Dim Scols,Srows,Ecols,Erows As Integer

@H_403_7@With FLex

@H_403_7@ Scols = .Col

@H_403_7@ Srows = .Row

@H_403_7@ Ecols = .ColSel

@H_403_7@ Erows = .RowSel

@H_403_7@If .ColSel > .Col And .RowSel > .Row Then

@H_403_7@ Scols = .Col

@H_403_7@ Srows = .Row

@H_403_7@ Ecols = .ColSel

@H_403_7@ Erows = .RowSel

@H_403_7@ElseIf .ColSel < .Col And .RowSel < .Row Then

@H_403_7@ Scols = .ColSel

@H_403_7@ Srows = .RowSel

@H_403_7@ Ecols = .Col

@H_403_7@ Erows = .Row

@H_403_7@ElseIf .ColSel > .Col And .RowSel < .Row Then

@H_403_7@ Scols = .Col

@H_403_7@ Srows = .RowSel

@H_403_7@ Ecols = .ColSel

@H_403_7@ Erows = .Row

@H_403_7@ElseIf .ColSel < .Col And .RowSel > .Row Then

@H_403_7@ Scols = .ColSel

@H_403_7@ Srows = .Row

@H_403_7@ Ecols = .Col

@H_403_7@ Erows = .RowSel

@H_403_7@End If

@H_403_7@

@H_403_7@ If .Col = 1 And .Row = 1 Then

@H_403_7@ Scols = 0

@H_403_7@ Srows = 0

@H_403_7@ End If

@H_403_7@

@H_403_7@End With

@H_403_7@

@H_403_7@

@H_403_7@Dim i,J As Integer

@H_403_7@Dim str As String

@H_403_7@Dim Fileopens As Boolean

@H_403_7@On Error GoTo err

@H_403_7@

@H_403_7@ str = ""

@H_403_7@ If Srows = 0 Then

@H_403_7@ For i = Scols To Ecols '@H_403_7@复制表头

@H_403_7@ If i = Scols Then

@H_403_7@ ' str = str & FLex.TextMatrix(0,i)

@H_403_7@ Else

@H_403_7@ str = str & Chr(9) & FLex.TextMatrix(0,i)

@H_403_7@ End If

@H_403_7@ Next

@H_403_7@ End If

@H_403_7@ For J = Srows To Erows

@H_403_7@ If J >= 1 Then

@H_403_7@ For i = Scols To Ecols

@H_403_7@ If i = Scols Then

@H_403_7@ Else

@H_403_7@ str = str & Chr(9) & FLex.TextMatrix(J,i)

@H_403_7@ End If

@H_403_7@ Next

@H_403_7@ str = str & vbCrLf

@H_403_7@ End If

@H_403_7@ Next

@H_403_7@ Clipboard.Clear ' @H_403_7@清除剪贴板

@H_403_7@ Clipboard.SetText str ' @H_403_7@将正文放在剪贴板上

@H_403_7@Screen.MousePointer = 0

@H_403_7@

@H_403_7@

@H_403_7@ err:

@H_403_7@ Select Case err.Number

@H_403_7@ Case 0

@H_403_7@ Case Else

@H_403_7@Screen.MousePointer = 0

@H_403_7@ MsgBox err.Description,vbInformation,"@H_403_7@复制出错@H_403_7@"

@H_403_7@ Exit Function

@H_403_7@ End Select

@H_403_7@End Function

@H_403_7@5. @H_403_7@打印@H_403_7@MSHFLEXGRID

@H_403_7@Sub InitPrint() ‘@H_403_7@初始化打印机

@H_403_7@Printer.Orientation = 2 ‘@H_403_7@横向为@H_403_7@2@H_403_7@，纵向为@H_403_7@1

@H_403_7@Printer.ScaleMode = 6 ‘@H_403_7@以@H_403_7@mm@H_403_7@为单位

@H_403_7@Printer.ScaleLeft = 30 '@H_403_7@左边界

@H_403_7@Printer.ScaleTop = 30 ‘@H_403_7@上边界

@H_403_7@Printer.ScaleHeight = 300 ‘@H_403_7@设定高度

@H_403_7@Printer.ScaleWidth = 200 ‘@H_403_7@设置宽度

@H_403_7@End Sub

@H_403_7@Sub PrintMSHGrid(FlexGrid As MSHFlexGrid)

@H_403_7@InitPrint

@H_403_7@FlexGrid.Parent.PrintForm

@H_403_7@Printer.EndDoc

@H_403_7@End Sub

@H_403_7@

@H_403_7@6. MSHFLEXGRID@H_403_7@的输出

@H_403_7@Public Sub OutDataToText(FLex As MSHFlexGrid) ‘输出到TXT文本

@H_403_7@ Dim s As String

@H_403_7@ Dim i As Integer

@H_403_7@ Dim J As Integer

@H_403_7@ Dim k As Integer

@H_403_7@ Dim strTemp As String

@H_403_7@ Dim Fname As String

@H_403_7@

@H_403_7@If FLex.Rows > 2 Then

@H_403_7@If FLex.Parent.Name = "WebData" Then Fname = "myfilename-" & WebData.SelNode & ".txt"

@H_403_7@'检查并创建临时文件夹

@H_403_7@Call CheckPath

@H_403_7@ On Error Resume Next

@H_403_7@ DoEvents

@H_403_7@ Dim FileNum As Integer

@H_403_7@ FileNum = FreeFile

@H_403_7@ Open App.Path & "/Temp/" & Fname For Output As #FileNum

@H_403_7@ With FLex

@H_403_7@ k = .Rows

@H_403_7@ For i = 0 To k - 1

@H_403_7@ strTemp = ""

@H_403_7@ For J = 0 To .Cols - 1

@H_403_7@ DoEvents

@H_403_7@ strTemp = strTemp & .TextMatrix(i,J) & ","

@H_403_7@ Next J

@H_403_7@ Print #FileNum,Left(strTemp,Len(strTemp) - 1)

@H_403_7@ Next i

@H_403_7@ End With

@H_403_7@ Close #FileNum

@H_403_7@ MsgBox “@H_403_7@保存成功@H_403_7@!@H_403_7@文件名为@H_403_7@" & Fname & vbCrLf & "@H_403_7@保存路径为@H_403_7@:" & vbCrLf & App.Path & "/Temp"

@H_403_7@ Else

@H_403_7@ MsgBox "@H_403_7@无数据，请检查@H_403_7@"

@H_403_7@ End If

@H_403_7@End Sub

@H_403_7@

@H_403_7@Sub ExporToExcel(FLex As MSHFlexGrid) ‘输出到Excel

@H_403_7@Dim xlapp As Excel.Application

@H_403_7@Dim xlbook As Excel.Workbook

@H_403_7@Dim xlsheet As Excel.Worksheet

@H_403_7@With FLex

@H_403_7@If .Rows > 2 Then

@H_403_7@If FLex.Parent.Name = "WebData" Then Fname = "Myfilename-" & WebData.SelNode & ".xls"

@H_403_7@Call CheckPath

@H_403_7@

@H_403_7@Set xlapp = CreateObject("Excel.Application") '创建Excel对象

@H_403_7@xlapp.Application.Visible = False

@H_403_7@On Error Resume Next

@H_403_7@Set xlbook = xlapp.Workbooks.Add

'设定单元格格式

@H_403_7@With xlbook.Worksheets(1)

@H_403_7@.Name = Fname

@H_403_7@.Range("A1:M1").Font.Color = vbBlue

@H_403_7@.Range("A1:M1").Font.Bold = True

@H_403_7@Columns("A:M").EntireColumn.AutoFit

@H_403_7@End With

'开始传输数据

@H_403_7@k = 0

@H_403_7@ For i = 0 To .Rows - 1

@H_403_7@ For J = 0 To .Cols - 1

@H_403_7@ xlbook.Worksheets(1).Cells(i + 1,J + 1) = .TextMatrix(i,J)

@H_403_7@ Next J

@H_403_7@ Next i

@H_403_7@

@H_403_7@xlbook.Worksheets(1).Columns("A:M").EntireColumn.AutoFit

@H_403_7@xlbook.SaveAs App.Path & "/Temp/" & Fname

@H_403_7@xlbook.Application.Quit

@H_403_7@Set xlbook = Nothing

@H_403_7@ MsgBox “@H_403_7@保存成功@H_403_7@!@H_403_7@文件名为@H_403_7@" & Fname & vbCrLf & "@H_403_7@保存路径为@H_403_7@:" & vbCrLf & App.Path & "/Temp"

@H_403_7@Else

@H_403_7@ MsgBox "@H_403_7@无数据，请检查@H_403_7@"

@H_403_7@

@H_403_7@End If

@H_403_7@End With

@H_403_7@End Sub

@H_403_7@Sub CheckPath()

@H_403_7@ If Dir(App.Path & "/Temp",vbDirectory) = "" Then

@H_403_7@ MkDir App.Path & "/Temp"

@H_403_7@ End If

@H_403_7@End Sub

原文链接：https://www.f2er.com/vb/262000.html

猜你在找的VB相关文章

VB Format函数
Format[$] ( expr [ , fmt ] ) format 返回变体型 format$ 强制返回为文本 --------------...
vb6/ASP FORMAT MM/DD/YYYY
VB6或者ASP 格式化时间为 MM/dd/yyyy 格式，竟然没有好的办法， Format 或者FormatDateTi...
VB.net 捕获项目全局异常
在项目中添加如下代码：新建窗口来显示异常信息。 Namespace My ‘全局错误处理，新的...
实现用VB.Net/(C#)开发K/3 BOS 插件的真正可行方法
转了这一篇文章，原来一直想用C#做k3的插件开发，vb没有C#用的爽呀，这篇文章写与2011年，...
vb，wps，excel 分裂
Sub 分列() ‘以空格为分隔符，连续空格只算1个。对所选中的单元格进行处理 Dim m...
VB.NET MYSQL DataGridView 增删改查（INSERT,SELECT,UPDATE,DELETE）
  Imports MySql.Data.MySqlClient Public Class Form1 ‘ GLOBAL DECLARATIONS ...
VB.NET 使用ADODB連接資料庫滙出到EXCEL
‘導入命名空間 Imports ADODB Imports Microsoft.Office.Interop   Private Sub A1() Di...
vb.net 多线程運用 ping
Imports System.IO Imports System.Threading Imports System.Diagnostics Public Class F...
VB等待进程结束
VB运行EXE程序，并等待其运行结束 参考：https://blog.csdn.net/useway/article/details/5...
vb中去掉string数组的一部分
今天碰到一个问题，登陆的时候，如果不需要验证手机号为空，则不去验证手机号 因为登陆的时...
PHPJavaJava SEPythonC#C&C++RubyVBasp.NetGoPerlnettyDjangoDelphiJsp.NET CoreSpringFlaskSpringbootSpringMVCLuaLaravelMybatisAspGroovyThinkPHPYiiswoole
文件时间pythonm相等性PHP Warning时间问题问题解决pcntl_signal采样点wav模块动态文本调用频率限制对外暴露多个访问请求更新数据表模型结构type()方法比较速度手写体sobel算子保存模型Image类nn.Conv2dpytorch1.0kaggleDCGAN交并比range()用法打印模型反卷积卷积