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

cbtaja

主代码如下（API和事件代码请看附件）：

1. Option Explicit
   
2. Public x&, y&
   
3. 
   
4. Sub GDIDraw()
   
5. Dim x&, y&, ZM#, r&, c&, x0&, y0&, flag&
   
6. '可在此处设置开关
   
7. 
   
8. ZM = ActiveWindow.Zoom / 100 '显示的缩放倍数
   
9. Dim Rg As Range
   
10. Set Rg = ActiveWindow.RangeSelection.Areas(1)
    
11. 
    
12. Dim 左 As Double, 顶 As Double, 宽 As Double, 高 As Double
    
13. With Rg
    
14.     左 = .Left
    
15.     顶 = .Top
    
16.     宽 = .Width
    
17.     高 = .Height
    
18. End With
    
19. 
    
20. Dim x1&, y1&, x2&, y2& '
    
21. With ActiveWindow '对选定区域Rg的左上顶点和右下顶点，计算屏幕坐标(单位：像素)
    
22.     '先计算两个坐标系统的偏移量
    
23.     r = .SplitRow + 1: c = .SplitColumn + 1
    
24.     '窗格拆分或冻结时产生的偏移量
    
25.     If c > 1 Then x0 = Cells(1, c).Left * ZM * dpiX / INCH2POINTS '原点偏移量
    
26.     If r > 1 Then y0 = Cells(r, 1).Top * ZM * dpiY / INCH2POINTS
    
27.    
    
28.     If .DisplayHeadings Then '行号列标在窗口拆分时带来的坐标原点偏移量
    
29.         flag = 0
    
30.         If .Split = True Then
    
31.             If .FreezePanes = True Then
    
32.                 flag = 3
    
33.             Else
    
34.                 flag = 2
    
35.             End If
    
36.         Else
    
37.             If .FreezePanes = True Then flag = 1
    
38.         End If
    
39.         If flag > 0 Then
    
40.             .FreezePanes = False: .Split = False
    
41.             If c > 1 Then x = .PointsToScreenPixelsX(0)
    
42.             If r > 1 Then y = .PointsToScreenPixelsY(0) - .PointsToScreenPixelsY(.Top * ZM * dpiY / INCH2POINTS) '
    
43.             .SplitRow = r - 1: .SplitColumn = c - 1
    
44.             If flag = 2 Then .Split = True
    
45.             If flag = 3 Then .FreezePanes = True
    
46.         End If
    
47.     End If
    
48.     '最终的坐标：
    
49.     x1 = .PointsToScreenPixelsX(左 * ZM * dpiX / INCH2POINTS) + IIf(c > 1, x0 + x, 0) '坐标转换计算。X方向附加原点漂移值x0、x
    
50.     y1 = .PointsToScreenPixelsY(顶 * ZM * dpiY / INCH2POINTS) + IIf(r > 1, y0 + y, 0)
    
51.     x2 = x1 + 宽 * ZM * dpiX / INCH2POINTS
    
52.     y2 = y1 + 高 * ZM * dpiY / INCH2POINTS
    
53. End With
    
54. draww x1, y1, x2, y2, RGB(255, 0, 0) '聚光灯颜色rgb值，本例简单设为红色（可调用EXCEL内置的颜色自定义对话框）。如颜色不支持，则容易闪屏。
    
55. End Sub
    

复制代码

cbtaja

聚光灯（仅做选区着色）.rar (20.6 KB, 下载次数: 207)

2014-4-16 22:59 上传

点击文件名下载附件

liucqa

cbtaja 发表于 2014-4-16 22:59

拆分窗格之后，不太准，再改改

cbtaja

liucqa 发表于 2014-4-16 23:15
拆分窗格之后，不太准，再改改

拆分窗格时，不同的窗格有不同的原点偏移量。
因为EXCEL2003下的ActivePane对象不能使用.PointsToScreenPixels方法，我是通过计算原点偏移量来模拟EXCEL2007下面的ActivePane.PointsToScreenPixels方法，仅以窗格的第4区为当前ActivePane为基准进行计算。因此，在拆分窗格时，左上3个区都会有偏移量，偏移值分别为第一区的两个方向的边长。但在冻结时，默认即为第4区，应不存在问题。因为拆分窗格时，逐一窗格判断、计算太过啰嗦、且较少应用（我个人的体会），所以没有列出，行列着色也没有写。因为选区着色要求更精准，任何方向偏移了都马上看出来。
关键在于计算原点偏移量。
其它情况下，理论上应不会有大偏差，但从Point换算到Pixel时，数据从双精度型到长整型，可能会存在数值计算的精度误差。

liucqa

cbtaja 发表于 2014-4-16 23:50
拆分窗格时，不同的窗格有不同的原点偏移量。
因为EXCEL2003下的ActivePane对象不能使用.PointsToScreen ...

没太看明白你的意思，我看到的是这样的，Excel2010


貌似没法用

wangminbai

有兴趣可以看一下 Kutools for Excel 7.50 的 阅读视图 功能， 具体可以参见：http://hi.baidu.com/officecm/item/4634973be26817c32f8ec2f0

支持 Excel 2007、2010 和 2013
支持鼠标滚动，滚动条拉动等
支持窗格拆分和窗格冻结
支持多种视图，包括普通、页面布局和分页预览
支持 Excel 宏表
可以自定义为填充、边框和线条样式，可以设定填充的透明度和颜色等
支持工作表多选区
支持工作表从右到左显示

运行截图：

Excel 2013

多选区支持

窗格拆分

Excel 宏表

页面布局视图支持

边框样式

配置选项

Excel 2010

liucqa

wangminbai 发表于 2014-4-18 14:18
有兴趣可以看一下 Kutools for Excel 7.50 的 阅读视图 功能， 具体可以参见：http://hi.baidu.com/officec ...

图片都看不见，你还是截图上传吧

wangminbai

liucqa 发表于 2014-4-18 20:41
图片都看不见，你还是截图上传吧

记得某些论坛有自动转存的功能，这个没有？

张雄友

找了这么久，8楼的最好用。

exaction

好好研究一下