excel中如何实现在选中某一个单元格后使其改变背景颜色,在鼠标移开后,其颜色又恢复为无色 5

excel中如何实现在选中某一个单元格后使其改变背景颜色,在鼠标移开后,其颜色又恢复为无色,注意如果在此时退出excel表,该单元格的颜色也需要恢复为无色?谢谢!... excel中如何实现在选中某一个单元格后使其改变背景颜色,在鼠标移开后,其颜色又恢复为无色,注意如果在此时退出excel表,该单元格的颜色也需要恢复为无色?谢谢! 展开
 我来答
抬头苦干
2011-01-01 · TA获得超过148个赞
知道小有建树答主
回答量:70
采纳率:0%
帮助的人:64.5万
展开全部

最好通过VBA编程实现:

思路:

1、对选定区域内的所有单元格进行判定:若地址和激活单元格相同,底色为某种颜色(如红色);否则为无色。

2、退出前再次判定:若有单元格底色不为无色,则设置为无色。

具体步骤:(设填充底色为红色)

1、确定需要满足变色单元格的区域(如A1:D10)

2、第一轮判定:打开Excel,按Alt+F11进入VB界面,双击左侧【工程-VBAProject】窗口中的“Sheet1(Sheet1)”进入代码窗口,粘贴如下代码后保存代码:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim i As Range

    For Each i In Range("A1:D10")

        If i.Address = Target.Address Then i.Interior.ColorIndex = 3 Else i.Interior.ColorIndex = 0 

        '代码解释:若选定区域的某一单元格地址与当前激活单元格相同,底色设置为红色,否则为无色。

    Next

End Sub

3、第二轮判定:双击【工程-VBAProject】窗口中的“ThisWorkbook”进入代码窗口,粘贴如下代码后保存代码:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Dim ii As Range

    For Each ii In Range("A1:D10")

        If ii.Interior.ColorIndex <> 0 Then ii.Interior.ColorIndex = 0

    Next

End Sub

4、后续工作:保存代码、保存文件(文件类型为带宏的Excel)。退出VB界面,在A1:D10中激活任一单元格,则底色置红色。保存文件后,退出时可看到红色区域消失。

注意事项:

1、该方法需要在代码中人为修改符合要求的单元格区域范围(如上面的A1:D10),执行时可根据需要自行修改,也可以通过输入对话框Inputbox()等方式自动引入(此处从略)。

2、底色颜色不一定为红色,可将Interior.ColorIndex属性值改为其他自然数,颜色对照表参见下面的链接:

http://blog.sina.com.cn/s/blog_44cb3d3d0100fzh7.html

3、如有疑问或更好的想法可发邮件到zandong_19@yahoo.cn,欢迎交流学习!

sqchzm
2011-01-01 · TA获得超过594个赞
知道小有建树答主
回答量:515
采纳率:100%
帮助的人:178万
展开全部
楼上的解决方法不错,赞一个。
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
SimoneLH
2011-01-02
知道答主
回答量:6
采纳率:0%
帮助的人:6.6万
展开全部
在工作薄中的任意工作表中添加两个窗体按钮控件,将指定其设置宏 分别指定为为ChangeColor 和 StopChange。下面是代码:

Option Explicit
Declare Function GetCursorPos _
Lib "user32" ( _
lpPoint As POINTAPI) _
As Long
Type POINTAPI
X As Long
Y As Long
End Type
Dim ChangeOn As Boolean
Dim OldRange As Range
Dim OldColorIndex As Integer
Dim blnStop As Boolean
Sub StopChange()
On Error Resume Next
If Not blnStop Then
blnStop = True
End If
End Sub

Sub ChangeColor()
Dim LngCurPos As POINTAPI
Dim NewRange As Range
On Error Resume Next
blnStop = False
If ChangeOn Then
Exit Sub
Else
ChangeOn = True
End If
Do
If blnStop = True Then Exit Do
GetCursorPos LngCurPos
On Error Resume Next
Set NewRange = ActiveWindow.RangeFromPoint(LngCurPos.X, LngCurPos.Y)
If Err <> 0 Then
OldRange.Interior.ColorIndex = OldColorIndex
Else
If NewRange.Address <> OldRange.Address Then
If OldRange Is Nothing Then
Else
OldRange.Interior.ColorIndex = OldColorIndex
End If
OldColorIndex = NewRange.Interior.ColorIndex
NewRange.Interior.ColorIndex = 3
End If
Set OldRange = NewRange
End If
On Error GoTo 0
DoEvents
Loop
ChangeOn = False
End Sub
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
sealcheng
2011-01-02 · TA获得超过301个赞
知道小有建树答主
回答量:471
采纳率:0%
帮助的人:153万
展开全部
研究研究!
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
收起 1条折叠回答
收起 更多回答(2)
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式