回复 13楼 hmj0745
漂亮的布局,能不能分享一下原始文件……我也想看看这些怎么弄出来的
回复 13楼 hmj0745
这个表格控件漂亮,叫什么名字啊……朋友
Private Sub 查询_Click() On Error GoTo errmsg 'Dim t 't = Timer '//开始时间 Call LockWindowUpdate(Me.hwnd) '//禁止更新防止闪烁 Me.MSHFlexGrid1.Clear StrDB = "\data\2商务项目.accdb" myTable = "B1客户列表" If Me.查询大类 = "" Or Me.关键字 = "" Then SQL = "select * from " & myTable & " ORDER BY 客户编号 DESC" '// DESC反序" Else Dim NB As String: NB = Me.查询大类 Dim Cx As String: Cx = Me.关键字 SQL = "SELECT * FROM " & myTable & " where " & NB & " like '%" & Cx & "%'" End If Opendb (StrDB) Set RS = CreateObject("adodb.recordset") '//创建一个数据集保存数据 RS.Open SQL, cnn, 1, 3 '//数据集保存数据 Set Me.MSHFlexGrid1.DataSource = RS Me.Frame2.Caption = "***列表" & RS.RecordCount & "项***" Call setCol(Me, MSHFlexGrid1, 500, 400) '//自适应列宽,根据是否超首行宽度进行不同的系数补偿 Call SetRowFont(MSHFlexGrid1, 350, 350, 11, 9) '//分别设定首行高度和下面的行高 Call setColAlig(Me, MSHFlexGrid1, 1) '//设置数据对齐方式 Call setBackcol(MSHFlexGrid1) '//设置隔行背景色 Call LockWindowUpdate(0) '//开启更新 GoTo 111 errmsg: MsgBox Err.Description, , "错误报告" 111 'MsgBox "查询完毕!一共用时:" & Format(Timer - t, "#0.0000") & " 秒", , "系统提示!!" '//提示所用时间 Disconnect End Sub
'01函数名: SetrowFont '函数功能: MSHFlexGrid设定单元格隔行背景色 '参数说明: 表格控件名,首行高,其它行高,首行字号,其它行字号 '***************************************************************************************** '***************************************************************************************** Public Sub SetRowFont(MSHF As Object, RowH1 As Long, RowH As Long, TextSize1 As Single, TextSize As Single) Dim i As Integer, j As Integer With MSHF .TextMatrix(0, 0) = "序号" .RowHeight(0) = RowH1 '//第一行行高 For i = 1 To .Rows - 1 .TextMatrix(i, 0) = i '//在第一列写入行号 .RowHeight(i) = RowH '//其它行行高 Next .CellFontName = "宋体" .CellFontSize = TextSize ' .ForeColorFixed = RGB(0, 0, 0) '//标头字体色 ' .ForeColor = RGB(0, 0, 0) '//普通单元格字体颜色 For j = 0 To .Cols - 1 .Row = 0 .Col = j .CellFontSize = TextSize1 Next End With End Sub '02函数名: setCol '函数功能: MSHFlexGrid设定行自适用列宽+补偿 '***************************************************************************************** '***************************************************************************************** Public Sub setCol(Myform As Form, MSHF As Object, B1 As Long, b2 As Long) Dim x, y As Integer Dim Width0, maxwidth, minwidth As Double With MSHF For y = 1 To .Cols - 1 Width0 = 0 For x = 0 To .Rows - 1 If x = 0 Then Width0 = Myform.TextWidth(.TextMatrix(x, y)) '// 把第一行的字段宽度做为初始列宽 GoTo 222 ' 第一行取得列宽初始值后直接跳转到此 End If If Myform.TextWidth(.TextMatrix(x, y)) > Width0 Then Width0 = Myform.TextWidth(.TextMatrix(x, y)) '// 遍历此列找到最宽的一个一行数据,赋给Width0 End If 222 Next If Width0 = Myform.TextWidth(.TextMatrix(0, y)) Then '//对字段做出判断 .ColWidth(y) = Width0 + b2 ' //如果列内字符长度不超过首行则补偿系数为b2 Else .ColWidth(y) = Width0 + B1 ' //如果列内字符串长度超过首行则补偿系数为B1 End If Next End With MSHF.ColWidth(0) = 600 '// 在此直接对第一列做出固定定义 End Sub '02函数名: setColAlig '函数功能: MSHFlexGrid设定单元格对齐方式 '***************************************************************************************** '***************************************************************************************** Public Sub setColAlig(Myform As Form, MSHF As Object, x As Integer) Dim y As Integer For y = 0 To MSHF.Cols - 1 MSHF.ColAlignment(y) = x MSHF.FixedAlignment(y) = 4 '设置首行的对齐方式 Next End Sub '02函数名: setbackcol '函数功能: MSHFlexGrid设定单元格隔行背景色 '***************************************************************************************** '***************************************************************************************** Public Sub setBackcol(MSHF As Object) Dim x As Integer With MSHF .AllowBigSelection = True '设置网格样式 .FillStyle = flexFillRepeat For x = 1 To .Rows - 1 .Row = x: .Col = .FixedCols .ColSel = .Cols() - .FixedCols ' - 1 If x Mod 2 = 0 Then .CellBackColor = vbWhite '白 Else .CellBackColor = RGB(213, 216, 217) ' End If Next '.FocusRect = flexFocusNone End With End Sub
[此贴子已经被作者于2021-12-10 22:39编辑过]
[此贴子已经被作者于2021-12-11 20:03编辑过]