[申请精华]背景高亮着色-完美解决冻结，拆分，缩放，隐藏(适用Excel2007以上）

loze2000

代码借鉴了stanleypan在模仿XColor 功能的加载宏里面的源代码。
优点：
1，直接计算选中单元格（或区域）的屏幕坐标值
2，直接计算拟画高亮边框矩形值。
3，直接在Windows系统桌面DeskTop的DC上作图，它使用的就是屏幕坐标值。
4，完美解决了冻结，拆分和隐藏单元格的影响。

对stanleypan不足的改进：
1，stanleypan使用了一个比较本色的办法，采用API函数GetCursor获取当前鼠标位置（屏幕像素坐标），左右移动，判断该移动的点下面是不是当前选中的Cell，以此来获得选中单元格的边界。
     可悲的是，键盘移动就会混乱。
2，后面的版本（stanleypan封装成了dll，所以看不见源码），stanleypan应该使用了获取输入光标（不是鼠标）屏幕像素坐标的办法，使用的是API函数GetCaretPos。这解决了键盘移动选中单位各的问题。

不足：使用了Pane.PointsToScreenPixelX函数，这个函数只有Excel2007版本以后版本才支持！

多说两句：
1，Excel的里面Window对象PointsToScreenPixelX函数非常失败，至今没弄明白它内部是怎么个原理。此前介绍说
         Window.PointsToScreenPixelX(X)= Window.PointsToScreenPixelX(0）+X 。得出的结果为屏幕坐标。其中输入的坐标应该是屏幕像素值。
但是，可悲的是在拆分和冻结下。在不同的Pane里面执行。结果让人混乱了。至今没理顺其关系。

2，Excel2007里面，给Pane添加了同样的函数PointsToScreenPixelX，可喜的是，这才是我们需要的函数。其X值就是Excel系统所使用的Point坐标系统值。输出的就是系统的屏幕坐标Pixel值。

上代码：

1. Option Explicit
   
2. 
   
3. '定义数据结构
   
4. Public Type POINTAPI '用于API里面的点
   
5.     x As Long
   
6.     y As Long
   
7. End Type
   
8. 
   
9. Public Type RECT
   
10.     Left As Long
    
11.     Top As Long
    
12.     Right As Long
    
13.     Bottom As Long
    
14. End Type
    
15. 
    
16. Public Type CustCOLORS
    
17.     crSelBack As Long
    
18.     crSelBorder As Long
    
19. End Type
    
20. 
    
21. '自定义变量
    
22. Public Colors As CustCOLORS '用clxXColor来操作它，真系不爽，待修改之
    
23. Public Const HWND_DESKTOP = 0 '在获取桌面句柄的参数
    
24. Public Const LOGPIXELSX = 88 '调用X方向上的系数
    
25. Public Const LOGPIXELSY = 90 '调用Y方向上的系数
    
26. 
    
27. 
    
28. 
    
29. '系统需要的变量
    
30. 'Public Const OCR_NORMAL = 32512
    
31. Public Const WHITE_BRUSH = 0
    
32. Public Const LTGRAY_BRUSH = 1
    
33. Public Const GRAY_BRUSH = 2
    
34. Public Const DKGRAY_BRUSH = 3
    
35. Public Const BLACK_BRUSH = 4
    
36. Public Const NULL_BRUSH = 5
    
37. Public Const HOLLOW_BRUSH = NULL_BRUSH
    
38. Public Const WHITE_PEN = 6
    
39. Public Const BLACK_PEN = 7
    
40. Public Const NULL_PEN = 8
    
41. Public Const OEM_FIXED_FONT = 10
    
42. Public Const ANSI_FIXED_FONT = 11
    
43. Public Const ANSI_VAR_FONT = 12
    
44. Public Const SYSTEM_FONT = 13
    
45. Public Const DEVICE_DEFAULT_FONT = 14
    
46. Public Const DEFAULT_PALETTE = 15
    
47. Public Const SYSTEM_FIXED_FONT = 16
    
48. Public Const STOCK_LAST = 16
    
49. 
    
50. 
    
51. 'SetROP2函数所用常量
    
52. '------'绘图模式常数表---------        常数             DrawMode                 像素值
    
53. Public Const R2_BLACK = 1    '  'R2_BLACK        vbBlackness                  黑色
    
54. Public Const R2_NOTMERGEPEN = 2    '  'R2_NOTMERGEPEN  vbNotMergePen               R2_MERGEPEN的反色
    
55. Public Const R2_MASKNOTPEN = 3    '  'R2_MASKNOTPEN   vbMaskNotPen            画笔颜色的反色与显示颜色进行AND运算
    
56. Public Const R2_NOTCOPYPEN = 4    '  'R2_NOTCOPYPEN    vbNotCopyPen            R2_COPYPEN的反色
    
57. Public Const R2_MASKPENNOT = 5    '  'R2_MASKPENNOT  vbMaskPenNot            显示颜色的反色与画笔颜色进行AND运算
    
58. Public Const R2_NOT = 6    '          'R2_NOT          vbInvert                当前显示颜色的反色
    
59. Public Const R2_XORPEN = 7    '  'R2_XORPEN        vbXorPen                   显示颜色与画笔颜色进行异或运算
    
60. Public Const R2_NOTMASKPEN = 8    '  'R2_NOTMASKPEN    vbNotMaskPen                  R2_MASKPEN的反色
    
61. Public Const R2_MASKPEN = 9    '  'R2_MASKPEN       vbMaskPen                   显示颜色与画笔颜色进行AND运算
    
62. Public Const R2_NOTXORPEN = 10    '  'R2_NOTXORPEN     vbNotXorPen                   R2_XORPEN的反色
    
63. Public Const R2_NOP = 11    '  'R2_NOP           vbNop                       不变
    
64. Public Const R2_MERGENOTPEN = 12    'R2_MERGENOTPEN   vbMergeNotPen         画笔颜色的反色与显示颜色进行OR运算
    
65. Public Const R2_COPYPEN = 13    '  'R2_COPYPEN     vbCopyPen                   画笔颜色
    
66. Public Const R2_MERGEPENNOT = 14    'R2_MERGEPENNOT  vbMergePenNot            显示颜色的反色与画笔颜色进行OR运算
    
67. Public Const R2_MERGEPEN = 15    '  'R2_MERGEPEN     vbMergePen                 画笔颜色与显示颜色进行OR运算
    
68. Public Const R2_WHITE = 16    '  'R2_WHITE       vbWhitness                    白色
    
69. Public Const R2_LAST = 16    '
    
70. 
    
71. 'GetSystemMetrics要用到的，获取窗口的边框大小，X表示横轴方向，Y表示纵轴方向
    
72. Public Const SM_CXBORDER As Long = 5
    
73. Public Const SM_CYBORDER As Long = 6
    
74. Public Const SM_CXDLGFRAME As Long = 7
    
75. Public Const SM_CYDLGFRAME As Long = 8
    
76. 
    
77. 
    
78. Public Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
    
79. 
    
80. Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    
81. 'Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    
82. 'Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
    
83. Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    
84. Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    
85. Public Declare Function GetCursor Lib "user32" () As Long
    
86. Public Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
    
87. 
    
88. 
    
89. Public Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle&, ByVal nWidth&, ByVal crColor&) As Long
    
90. Public Declare Function SetBkMode Lib "gdi32.dll" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
    
91. Public Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    
92. Public Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
    
93. Public Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, ByRef lColorRef As Long) As Long
    
94. Public Declare Function FrameRect Lib "user32.dll" (ByVal hdc As Long, ByRef lpRect As RECT, ByVal hBrush As Long) As Long
    
95. 
    
96. Public Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
    
97. Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
    
98. 
    
99. Public Declare Function Rectangle Lib "gdi32" (ByVal hdc&, ByVal x1&, ByVal y1&, ByVal x2&, ByVal y2&) As Long
    
100. Public Declare Function GetDesktopWindow Lib "user32" () As Long
     
101. Public Declare Function GetWindowDC Lib "user32.dll" (ByVal hwnd As Long) As Long
     
102. Public Declare Function SaveDC Lib "gdi32" (ByVal hdc As Long) As Long
     
103. Public Declare Function RestoreDC Lib "gdi32" (ByVal hdc As Long, ByVal nSavedDC As Long) As Long
     
104. Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
     
105. Public Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
     
106. Public Declare Function RedrawWindow Lib "user32" (ByVal hwnd As Long, lprcUpdate As RECT, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
     
107. Public Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long
     
108. Public Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
     
109. Public Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
     
110. Public Declare Function OffsetRect Lib "user32.dll" (ByRef lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
     
111. 
     
112. Public Declare Function GetCapture Lib "user32" () As Long
     
113. Public Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
     
114. Public Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
     
115. Public Declare Function GetCaretPos Lib "user32" (lpPoint As POINTAPI) As Long
     
116. Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
     
117. Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
     
118. 
     
119. Public Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
     
120. 
     
121.    
     
122. Public gButtonDown As Boolean '菜单上高亮是否有效。用来做切换开关，用菜单切换。以便需要时显示
     
123.    
     
124. Public Sub Do_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
     
125. '整理下思路
     
126. '难度在于，Excel中所有的长度、宽度单位都是以Point为单位。Point是真是长度单位，和Inch，Twip一样。1Point=1inch/72
     
127. '而系统函数(API)的的单位是使用Pixel（屏幕坐标），这是和长度不直接发生关系的。它需要根据系统的对照表来查询,从而得知其与Point等的对应关系。
     
128. '因此，我们想要获得当前活动单元格的边界范围，然后转化成系统的屏幕坐标。调用API函数完成画图。
     
129. '在画图时，DC的选择非常重要，为了简单，直接用"桌面DeskTop"的DC，这样，转化成的屏幕坐标直接可以用。
     
130. '这里特别注意，为什么不选择其他窗口的DC呢，因为其中设计到要将屏幕坐标转换到该窗口中去。由于列标题和行标题的存在，这似乎比较困难。
     
131. 
     
132.     '变量定义区
     
133.     Dim ActWinRect As RECT '当前主窗口矩形
     
134.     Dim VScrBarRect As RECT '定义垂直滚动条（ScrollBar）的矩形
     
135.     Dim HScrBarRect As RECT '定义水平滚动条ScrollBar的矩形框
     
136.     Dim actCellFrame As RECT '当前单元格的边界,上下左右，最远端
     
137.     Dim hdc As Long  '设备句柄变量
     
138.     Dim hWndWin As Long '定义Excel的主程序，工作区(XLDesk)，当前活动表的窗口句柄
     
139.     Dim hWndHScrBar, hWndVScrBar As Long '主窗口下面Scrollbar的句柄
     
140.     Dim HwdDesktop As Long '系统桌面的句柄
     
141.     Dim PointsPerPixelX, PointsPerPixelY As Single '点坐标转换成屏幕坐标的转换比率，X是横向，Y是纵向
     
142.     Dim brush As Long  '刷子
     
143.     'Dim color As clsColor '颜色
     
144.     Dim HighLightRect As RECT '画框矩形
     
145.     Dim winSysBoderWidth, winSysBoderHeight As Long '窗口边框大小
     
146.    
     
147.    
     
148.     On Error Resume Next
     
149.     If Not ModHighLight.gButtonDown Then Exit Sub  '菜单上没有选中"高亮显示"，则退出
     
150.     If Target.Areas.Count > 1 Then Exit Sub '如果是多个区域，则退出
     
151.    
     
152.         
     
153.     'Set color = New clsColor
     
154.     'color.WindowStyle = vbGreenStyle    ' vbXPStyle
     
155.    
     
156.     '获取点(Point)坐标转换成屏幕像素(Pixl)坐标时的转换比率，因为要用到直接画图，所以这个是必须的
     
157.     '注意：Point是绝对长度单位(=1/72Inch)。Excel中用的就是Point坐标
     
158.     PointsPerPixelX = (100 / ActiveWindow.Zoom) / (GetDeviceCaps(GetWindowDC(HWND_DESKTOP), LOGPIXELSX) / 72)  'X方向-每屏幕像素(Pixel)对应多少点(Point)
     
159.     PointsPerPixelY = (100 / ActiveWindow.Zoom) / (GetDeviceCaps(GetWindowDC(HWND_DESKTOP), LOGPIXELSY) / 72)   'Y方向-每屏幕像素(Pixel)对应多少点(Point)
     
160. 
     
161.     '获得鼠标所在的窗口句柄,重重查找，从XLMAIN 到XLDESK，再到EXCEL7
     
162.     hWndWin = FindWindow("XLMAIN", Application.Caption) 'Excel主程序窗口句柄
     
163.     hWndWin = FindWindowEx(hWndWin, 0&, "XLDESK", vbNullString) 'Excel工作区(XLDESK)窗口句柄
     
164.     hWndWin = FindWindowEx(hWndWin, 0&, "EXCEL7", vbNullString)    'Excel 主窗体句柄,主要是指当前ActiveSheet的窗口
     
165.     '还需要获得两个ScrollBar的句柄,其类名都是“NUIScrollbar”，标题各位“垂直”和“水平"
     
166.    
     
167.     hWndHScrBar = FindWindowEx(hWndWin, 0&, "NUIScrollbar", "水平") '水平滚动条的句柄
     
168.     hWndVScrBar = FindWindowEx(hWndWin, 0&, "NUIScrollbar", "垂直") '垂直滚动条的句柄
     
169.    
     
170.     '当前单元格的边界(在屏幕Pixl坐标下)
     
171.     actCellFrame.Left = CLng(ActiveWindow.PointsToScreenPixelsX(Target.Left / PointsPerPixelX))
     
172.     actCellFrame.Top = CLng(ActiveWindow.PointsToScreenPixelsY(Target.Top / PointsPerPixelY))
     
173.     actCellFrame.Right = actCellFrame.Left + CLng(Target.Width / PointsPerPixelX)
     
174.     actCellFrame.Bottom = actCellFrame.Top + CLng(Target.Height / PointsPerPixelY)
     
175.     '当前单元格的边界(在屏幕Pixl坐标下)
     
176.     actCellFrame.Left = CLng(ActiveWindow.ActivePane.PointsToScreenPixelsX(Target.Left))
     
177.     actCellFrame.Top = CLng(ActiveWindow.ActivePane.PointsToScreenPixelsY(Target.Top))
     
178.     actCellFrame.Right = actCellFrame.Left + CLng(Target.Width / PointsPerPixelX)
     
179.     actCellFrame.Bottom = actCellFrame.Top + CLng(Target.Height / PointsPerPixelY)
     
180.   
     
181.     winSysBoderWidth = GetSystemMetrics(SM_CXDLGFRAME) '获得系统窗口X方向边框大小
     
182.     winSysBoderHeight = GetSystemMetrics(SM_CYDLGFRAME) '获得系统窗口Y方向边框大小
     
183.     GetWindowRect hWndWin, ActWinRect '窗口矩形空间，在屏幕坐标下
     
184.     GetWindowRect hWndHScrBar, HScrBarRect '获得水平滚动条的矩形
     
185.     GetWindowRect hWndVScrBar, VScrBarRect '获得垂直滚动条的矩形
     
186.   
     
187.    '计算拟画列矩形的边框(在屏幕Pixel坐标下)，Column
     
188.     HighLightRect.Left = actCellFrame.Left
     
189.     HighLightRect.Top = ActWinRect.Top + winSysBoderHeight
     
190.     HighLightRect.Right = actCellFrame.Right
     
191.     HighLightRect.Bottom = ActWinRect.Bottom - (HScrBarRect.Bottom - HScrBarRect.Top) - 2 * winSysBoderHeight
     
192.    
     
193.     Application.ScreenUpdating = True '暂停更新，非常重要
     
194. 
     
195.     If hdc = 0 Then hdc = GetWindowDC(HWND_DESKTOP)   '获得Windows桌面绘图设备的句柄，因为我想所有坐标都在它之下，就不需要转换了。
     
196.      
     
197.     brush = CreateSolidBrush(RGB(193, 210, 238))    '创建蓝色画刷 (&HFF0000)
     
198.     Call SelectObject(hdc, brush) '在DC中选中刷子
     
199.     SetROP2 hdc, R2_NOTXORPEN    '异或(Xor)作图模式。不影响其他颜色对其的画图。
     
200.     Call SaveDC(hdc)    '保存画笔和刷子
     
201.     Call SelectObject(hdc, brush)    '设备空刷子
     
202.       
     
203.     Rectangle hdc, HighLightRect.Left, HighLightRect.Top, HighLightRect.Right, HighLightRect.Bottom '画列方向矩形
     
204.    
     
205.    
     
206.     '计算拟画行矩形的边框(在屏幕Pixel坐标下)，Row
     
207.     HighLightRect.Left = ActWinRect.Left + winSysBoderWidth
     
208.     HighLightRect.Top = actCellFrame.Top
     
209.     HighLightRect.Right = ActWinRect.Right - (VScrBarRect.Right - VScrBarRect.Left) - 2 * winSysBoderWidth
     
210.     HighLightRect.Bottom = actCellFrame.Bottom
     
211.    
     
212.     Rectangle hdc, HighLightRect.Left, HighLightRect.Top, HighLightRect.Right, HighLightRect.Bottom '画行方向矩形
     
213. 
     
214.     Call RestoreDC(hdc, -1)    '-1是恢复以前的内容'恢复DC设备，即回复SaveDC保存的DC
     
215.     ReleaseDC hWndWin, hdc    '删除窗口设备句柄,释放资源
     
216.     DeleteObject brush '删除画笔对象
     
217.     ReleaseDC hWndWin, hdc '释放句柄
     
218.    
     
219. 
     
220. End Sub

复制代码

下一步努力的目标就是：弃用Pane.PointsToScreenPixelX。使其适用与2003

edwin11891

效果很好，在我的2003上已经可以正常运行。改进效果不错，尤其对stanleypan不足的第一条改进，望继续完整。如高亮颜色可自选，另有窗口冻结时高亮显示行会出错。

wqfzqgk

你这里面的想法及用法有些不足，他们其实都不是这么做的

abclmc

怎么用啊？不会用啊，请指点

liucqa

一楼代码有点问题，简单改改，凑合能用了

GDI写的聚光镜.rar (29.6 KB, 下载次数: 751)

2013-5-25 20:20 上传

点击文件名下载附件

补充内容 (2013-6-10 23:14):
顺便说一下，这个代码绘图的时候写错HDC了，应该写到Excel7窗体上，这样代码简洁多了

ctp_119

这个不错，学习学习！！！

三戒

测试一下，在office 2013下，能瞬间显示一下，稍候就没有了，估计跟office 2013有关

liucqa

三戒 发表于 2013-6-8 18:02
测试一下，在office 2013下，能瞬间显示一下，稍候就没有了，估计跟office 2013有关

俺的DnaTools凑合能用GDI绘制，支持2013   http://club.excelhome.net/thread-1026277-1-1.html

罗刚君的百宝箱2013不是gdi写的，使用起来有限制
王明柏的KuTools 7.5功能比较完善，但是收费

这个是用shape做的，Jan Karel Pieterse作品
follow cell pointer.zip (36.16 KB, 下载次数: 627)

2013-8-24 01:22 上传

点击文件名下载附件

yf_home

liucqa 发表于 2013-5-25 20:20
一楼代码有点问题，简单改改，凑合能用了

效果不错，感谢分享。
测试了一下，选择整行或整列的时候，没有想要效果。

,

liucqa

yf_home 发表于 2013-9-17 20:51
效果不错，感谢分享。
测试了一下，选择整行或整列的时候，没有想要效果。

你想要什么？