我用Msflexgrid控件从EXCEL导入了数据,然后实时调整若干列的数据大小,问题是要使某一个单元格数据变化后颜色也要相应的变化。比如:大于1小于2 单元格颜色变黄,大于2颜色变红,请问怎么实现。我用的是一个循环,一个一个单元格与1 和2 进行大小比较,但是速度很慢,每次都要一个一个单元格进行比对,很卡,请问有没有快捷一点的方法,要设计到深层编程吗,比如Windows编程啥的?请高手指点。
这是从EXCEL里导入数据,我已经实现了,关键是怎么判断msflexgrid单元格数据大小然后使单元格变色。
VB高手进,Msflexgrid空间,如何在单元格数据满足一定条件,自动改变单元格颜色?
答案:1 悬赏:80 手机版
解决时间 2021-01-30 07:22
- 提问者网友:绫月
- 2021-01-29 13:21
最佳答案
- 五星知识达人网友:十年萤火照君眠
- 2021-01-29 14:27
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
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
我要举报
如以上问答信息为低俗、色情、不良、暴力、侵权、涉及违法等信息,可以点下面链接进行举报!
大家都在看
推荐资讯