求助 vba中如何将高亮显示限制在指定范围内快表软件

楼主 · 2024-12-27 09:20:09

Dim currentRow As Long, currentCol As Long
Dim colorIndex As Long
If GL Then
' 获取当前选中单元格的行号和列号
' msgbox("1")
currentRow = e.RangeSelection.Row
currentCol = e.RangeSelection.Column
' msgbox(currentRow & "12" & currentCol)
' 定义要使用的颜色索引（可以根据需要修改）
colorIndex = 16 ' 例如，使用黄色（索引6）
' 清除之前的高亮（如果有的话）
With AW.ActiveWorksheet.UsedRange.Interior
.Pattern = SpreadsheetGear.Pattern .None
End With
' msgbox("1234")
' 高亮显示当前行和列
If e.RangeSelection.Intersect(Range("T_113")) IsNot Nothing Then
With e.RangeSelection.EntireRow.Interior
' With Range("T_113").Rows(currentRow).EntireRow.Interior
.colorIndex = colorIndex
End With
' msgbox("12345")
With e.RangeSelection.EntireColumn.Interior
' With Range("T_113").EntireColumn.Interior
.colorIndex = colorIndex
End With
End If
End If

复制代码

e.RangeSelection.EntireRow.Interior 只能设置到整行或是整列

lexianfeng

Imports SpreadsheetGear
Imports C1.Silverlight
Imports C1.Silverlight.C1MessageBoxButton
Imports C1.Silverlight.C1MessageBoxIcon
Imports Newtonsoft.Json
Imports Newtonsoft.Json.Linq
Imports Microsoft.VisualBasic
Imports System.IO
Imports System.Text
Imports System.Net
Imports System.Windows.forms
Namespace ExcelViewVBDotnet
Public Class StandardInterface
'预留位置1
'预留位置2
Dim EV As SpreadsheetGear.Windows.Controls.WorkbookView
Dim AW As SpreadsheetGear.IWorkbook
Dim ActiveRange As SpreadsheetGear.IRange
' ===== 十字高亮相关变量 =====
' 高亮区域边界常量
Const RANGE_ROW_START As Integer = 1 ' A2 → 行索引从0起，第2行=索引1
Const RANGE_ROW_END As Integer = 49 ' 第50行=索引49
Const RANGE_COL_START As Integer = 0 ' A列=索引0
Const RANGE_COL_END As Integer = 25 ' Z列=索引25
' 高亮颜色
Dim HIGHLIGHT_COLOR As SpreadsheetGear.Color = SpreadsheetGear.Colors.Yellow
' 上次高亮的行列（-1 表示无）
Dim lastRow As Integer = -1
Dim lastCol As Integer = -1
' 保存原始颜色：rowColors(i) = 第i列单元格原色（同行高亮时）
' colColors(i) = 第i行单元格原色（同列高亮时）
Dim savedRowColors() As Integer ' 保存上次高亮行的各列原色
Dim savedColColors() As Integer ' 保存上次高亮列的各行原色
Dim savedCrossColor As Integer ' 保存交叉单元格原色（防止双重覆盖）
Public Sub Workbook_Open(OldRoot As Object, NewRoot As Object, Excel As SpreadsheetGear.Windows.Controls.WorkbookView)
EV = Excel
Excel.GetLock()
AW = Excel.ActiveWorkbook
ActiveRange = AW.ActiveWorksheet.Cells
Excel.ReleaseLock()
End Sub '打开时执行事件
Public Sub RangeSelection(sender As Object, e As SpreadsheetGear.Windows.Controls.RangeSelectionChangedEventArgs)
EV.GetLock()
Try
Dim cell As SpreadsheetGear.IRange = e.RangeSelection
If cell Is Nothing Then Return
Dim newRow As Integer = cell.Row
Dim newCol As Integer = cell.Column
' 判断选中单元格是否在目标区域内
Dim inRange As Boolean = (newRow >= RANGE_ROW_START AndAlso newRow <= RANGE_ROW_END _
AndAlso newCol >= RANGE_COL_START AndAlso newCol <= RANGE_COL_END)
Dim ws As SpreadsheetGear.IWorksheet = AW.ActiveWorksheet
' ── Step 1：恢复上次高亮区域的原始颜色 ──
If lastRow >= 0 AndAlso lastCol >= 0 Then
' 恢复上次高亮的行（跳过交叉点，最后单独恢复）
For c As Integer = RANGE_COL_START To RANGE_COL_END
If c <> lastCol Then
ws.Cells(lastRow, c).Interior.Color = SpreadsheetGear.Color.FromArgb(savedRowColors(c - RANGE_COL_START))
End If
Next
' 恢复上次高亮的列（跳过交叉点）
For r As Integer = RANGE_ROW_START To RANGE_ROW_END
If r <> lastRow Then
ws.Cells(r, lastCol).Interior.Color = SpreadsheetGear.Color.FromArgb(savedColColors(r - RANGE_ROW_START))
End If
Next
' 恢复交叉点原色
ws.Cells(lastRow, lastCol).Interior.Color = SpreadsheetGear.Color.FromArgb(savedCrossColor)
End If
' ── Step 2：若新选中单元格在区域内，保存并高亮 ──
If inRange Then
Dim colCount As Integer = RANGE_COL_END - RANGE_COL_START + 1
Dim rowCount As Integer = RANGE_ROW_END - RANGE_ROW_START + 1
ReDim savedRowColors(colCount - 1)
ReDim savedColColors(rowCount - 1)
' 保存新高亮行的各单元格原色
For c As Integer = RANGE_COL_START To RANGE_COL_END
savedRowColors(c - RANGE_COL_START) = ws.Cells(newRow, c).Interior.Color.ToArgb()
Next
' 保存新高亮列的各单元格原色
For r As Integer = RANGE_ROW_START To RANGE_ROW_END
savedColColors(r - RANGE_ROW_START) = ws.Cells(r, newCol).Interior.Color.ToArgb()
Next
' 交叉点的原色（行保存中已含，此处单独记录供精确恢复）
savedCrossColor = ws.Cells(newRow, newCol).Interior.Color.ToArgb()
' 高亮整行（在范围内）
For c As Integer = RANGE_COL_START To RANGE_COL_END
ws.Cells(newRow, c).Interior.Color = HIGHLIGHT_COLOR
Next
' 高亮整列（在范围内）
For r As Integer = RANGE_ROW_START To RANGE_ROW_END
ws.Cells(r, newCol).Interior.Color = HIGHLIGHT_COLOR
Next
lastRow = newRow
lastCol = newCol
Else
' 选中区域外，清除记录
lastRow = -1
lastCol = -1
End If
Finally
EV.ReleaseLock()
End Try
End Sub '单元格选择后执行的事件
Public Sub RangeChanged(sender As Object, e As SpreadsheetGear.Windows.Controls.RangeChangedEventArgs)
End Sub '单元格编辑完成后执行事件
Public Sub ButtunClick(sender As Object, e As SpreadsheetGear.Windows.Controls.ShapeActionEventArgs)
End Sub '按钮/标签点击事件
Public Sub FollowHyperlink(sender As Object, e As EventArgs)
End Sub '暂不支持
End Class
' 注：除事件字眼下可以自定义代码外的所有代码不允许改动，否则编译将有可能失败。
End Namespace

复制代码

快表帝国客服01

本帖最后由快表帝国客服01 于 2025-1-10 08:28 编辑

将currentRow与 currentCol限制在T_113的区域行列之内，也即是行号大于区域的第一行小于最后一行，列大于第一列小于最后一列，在整个范围内起作用
另：企业版默认支持该功能，不用自定义写VBA

快表帝国客服01

If e.RangeSelection.Intersect(Range("T_123")) IsNot Nothing Then
MessageBox.Show("YES!")
End If

lexianfeng

lexianfeng

快表帝国客服01

快表帝国客服01

精彩评论3

lexianfeng

快表帝国客服01

快表帝国客服01

浏览过的版块

产品与服务

网站地图