永发信息网

VB高手进,Msflexgrid空间,如何在单元格数据满足一定条件,自动改变单元格颜色?

答案:1  悬赏:80  手机版
解决时间 2021-01-30 07:22
我用Msflexgrid控件从EXCEL导入了数据,然后实时调整若干列的数据大小,问题是要使某一个单元格数据变化后颜色也要相应的变化。比如:大于1小于2 单元格颜色变黄,大于2颜色变红,请问怎么实现。我用的是一个循环,一个一个单元格与1 和2 进行大小比较,但是速度很慢,每次都要一个一个单元格进行比对,很卡,请问有没有快捷一点的方法,要设计到深层编程吗,比如Windows编程啥的?请高手指点。

这是从EXCEL里导入数据,我已经实现了,关键是怎么判断msflexgrid单元格数据大小然后使单元格变色。
最佳答案
Private Sub ImportExcel()

On Error Resume Next

Dim strPash As String

Dim XLS As Object

Dim WRK As Object

Dim SHT As Object

dsCmDlg.InitDir = App.Path

With dsCmDlg
.DefaultExt = "xls"
.ExtendedMode = 1
.Flags = fdlgOFN_EXPLORER Or fdlgOFN_ALLOWMULTISELECT Or fdlgOFN_SHOWHELP Or fdlgOFN_HIDEREADONLY
.Filter = "Excel(*.xls)|*.xls"
.HelpCommand = fdlgHELP_CONTEXT
.HelpContext = 31
.StartUpPosition = 3
.DialogLeft = 40
.DialogTop = 70
.ShowOpen
End With

strPash = dsCmDlg.fileName

If dsCmDlg.DialogCanceled Then Exit Sub
If strPash <> "" Then
txtConsumeFilePath.Text = strPash
cmbWorkSheet.Clear
'建立Excel新实例
Set XLS = CreateObject("Excel.Application")

'打开XLS文件. UpdateLink = False 和 ReadOnly = True.
Set WRK = XLS.Workbooks.Open(txtConsumeFilePath.Text, False, True)

'读取xls文件中的工作表
For Each SHT In WRK.Worksheets

'加载到列表框
cmbWorkSheet.AddItem SHT.Name
Next

cmbWorkSheet.ListIndex = 0
Call FillCoolGrid '加载第一张工作表

'关闭并不保存
WRK.Close False
'退出MS Excel
XLS.Quit

'释放变量
Set XLS = Nothing
Set WRK = Nothing
Set SHT = Nothing
Else
txtConsumeFilePath.Text = ""

End If

End Sub

Private Sub FillCoolGrid()

On Error GoTo errHandle

Dim XLS As New Excel.Application

Dim WRK As Excel.Workbook

Dim SHT As Excel.Worksheet

Dim RNG As Excel.Range

Dim r As Long

Dim c As Long

Dim i As Integer

Dim ArrayCells() As Variant

If cmbWorkSheet.ListIndex <> -1 Then
'建立Excel新实例
Set XLS = CreateObject("Excel.Application")
'打开 XLS 文件
Set WRK = XLS.Workbooks.Open(txtConsumeFilePath.Text, False, True)
'把当前选择的工作表赋值给SHT
Set SHT = WRK.Worksheets(cmbWorkSheet.List(cmbWorkSheet.ListIndex))

'得到当前工作表的使用范围
Set RNG = SHT.UsedRange

'重新分配数组
ReDim ArrayCells(1 To RNG.Rows.Count, 1 To RNG.Columns.Count)

'在使用范围内使用新的数组传值
ArrayCells = RNG.value

'关闭工作表
WRK.Close False
'退出 Excel
XLS.Quit

'变量释放
Set XLS = Nothing
Set WRK = Nothing
Set SHT = Nothing
Set RNG = Nothing

'网格数据显示设置
CoolGrid.Redraw = False
CoolGrid.FixedCols = 0
CoolGrid.FixedRows = 0
CoolGrid.Rows = UBound(ArrayCells, 1)
CoolGrid.Cols = UBound(ArrayCells, 2)

For r = 0 To UBound(ArrayCells, 1) - 1
For c = 0 To UBound(ArrayCells, 2) - 1
CoolGrid.TextMatrix(r, c) = CStr(ArrayCells(r + 1, c + 1))

DoEvents
Next
Next

CoolGrid.Redraw = True

AdjustColWidth frmEmployeeImport, CoolGrid '调整Grid各列列宽为最合适的宽度
Else
cmbWorkSheet.SetFocus
End If

Exit Sub

errHandle:
Call PrintErrInfo(err.Number, err.Description)

Exit Sub

End Sub

'//自动调整Grid各列列宽为最合适的宽度
Public Sub AdjustColWidth(frmCur As Form, _
gridCur As Object, _
Optional bNullRow As Boolean = True, _
Optional dblIncWidth As Double = 0)

'--------------------------------------------------------------------
'功能:
' 自动调整Grid各列列宽为最合适的宽度
'参数:
' [frmCur].........................................当前工作窗体
' [gridCur]........................................当前要调整的Grid
'--------------------------------------------------------------------
Dim i, j As Integer

Dim dblWidth As Double

With gridCur

For i = 0 To .Cols - 1
dblWidth = 0

If .ColWidth(i) <> 0 Then

For j = 0 To .Rows - 1

If frmCur.TextWidth(.TextMatrix(j, i)) > dblWidth Then
dblWidth = frmCur.TextWidth(.TextMatrix(j, i))
End If

Next

.ColWidth(i) = dblWidth + dblIncWidth + 100
End If

Next

End With

End Sub
我要举报
如以上问答信息为低俗、色情、不良、暴力、侵权、涉及违法等信息,可以点下面链接进行举报!
大家都在看
广州市第九十七中学怎么去啊,我要去那办事
急性血管内溶血时可以出现的是()A.血清结合胆
演员刘蕾的老公是谁
天河区同仁实验学校地址在什么地方,我要处理
酉穴的意思是什么啊?知道的请说下!
下图为我国部分地区7月气温及年均降水量分布
哪里卖三国演义连环画
尼康d800开闪光灯最下部有阴影怎么回事
广州市第七十五中学怎么去啊,我要去那办事
石家庄哪里有卖电动葫芦的
苹果手机QQ空间新建不了相册是怎么回事
小叶紫檀手链盘玩时有划痕怎么办
求:20尺普柜、40尺普柜、40尺高柜、45尺高柜
垫子的意思是什么啊?知道的请说下!
耳朵和眼睛一样高
推荐资讯
脱毛膏、蜜蜡、汗毛漂白剂哪个好
博士眼镜(公明天虹店)地址在什么地方,想过去
求欧美三部曲的电影
便条的意思是什么啊?知道的请说下!
和公馆茶楼棋牌怎么去啊,我要去那办事
Love you every day is different
红崖底村地址在什么地方,我要处理点事
谁能给我推荐一个显示IP的QQ版本,关键要稳定
我像换蓝色的灯泡、酒吧用.请问从哪可以买到
谢珊我永远爱你韩语怎么写
单位退休职工如何做生存认证?
厦门银行(麦市街)怎么去啊,我要去那办事
正方形一边上任一点到这个正方形两条对角线的
阴历怎么看 ?