【重磅发布】：聚光灯——我的加载宏系列小工具【单元格小工具】之四

ggmmlol

继续播放《窗体“变形记”》第二集

接下来，我们先让窗体变成所“选定的【单元格区域】”的大小。

“选定的【单元格区域】”，在通常情况下，它就是Application.Selection对象。但是，当表格中存在有图片、形状、“单元格相片”（由“照相机”取得的单元格的动态图形）、文本框、表单控件、或ActiveX控件、外部文档对象时，我们有可能选中它们中的一个或多个，而这时，Application.Selection的对象就成了所选取的这些对象。所以，Application.Selection对象不是正确的目标。

那么，EXCEL中，要用那个对象来准确地表示 “选定的【单元格区域】”呢？
答案是：Application.ActiveWindow.RangeSelection。这个对象，才准确地表示了EXCEL活动工作簿窗口的活动单元格区域。

让我们先来看一看RangeSelection在帮助文档中的说明：

ggmmlol

改变窗体的大小，可以使用其Width和Height属性来完成。
所以，让窗体的大小适应单元格区域的大小，只需要先计算出这个单元格区域的大小即可。
为了后面便于应用，我们让Sub过程也像Function过程一样带有一个参数，其类型为Range
首先，从最简单的方式开始，选择一个“固定靶”，就定为单元格区域“A1:E5”吧。
代码如下：

1. Private Sub UserFormFitRange(ByVal oRng As Range)
   
2.     Dim lft, tp, rght, btn, wd, ht
   
3.     With oRng
   
4.         .Parent.Parent.Windows(1).Zoom = 100
   
5.         lft = .Cells(1).Left
   
6.         tp = .Cells(1).Top
   
7.         rght = .Cells(1, .Columns.Count).Left + .Cells(1, .Columns.Count).Width
   
8.         btn = .Cells(.Rows.Count, 1).Top + .Cells(.Rows.Count, 1).Height
   
9.         wd = rght - lft
   
10.         ht = btn - tp
    
11.     End With
    
12.    
    
13.     Unload UserForm1    '此步骤使窗体在下次显示时恢复默认风格，以便能够用鼠标来移动它。
    
14.                         '否则，如果窗体已经设为鼠标穿透的话，就不能用鼠标来移动它了
    
15.    
    
16.     With UserForm1
    
17.         .Width = wd
    
18.         .Height = ht
    
19.         .Show 0
    
20.     End With
    
21. End Sub
    
22. 
    
23. Private Sub UserFormFightRangeSelection()
    
24.     With Application.ActiveWindow
    
25.         UserFormFitRange .RangeSelection.Areas(1)
    
26.     End With
    
27. End Sub
    
28. 
    
29. Sub UserformFitA1E5()
    
30.     Range("A1:E5").Activate
    
31.     UserFormFightRangeSelection
    
32. End Sub

复制代码

运行宏 UserformFitA1E5，可以看到，窗体显示在EXCEL窗口的中心，而其大小，已经变成单元格区域“A1:E5"的大小了。这可以通过把窗体移动到单元格区域A1:E5来直观地得到验证，如下面的两张图片所示：
第一张图，是窗体显示出来时的状态

第二张图，是在手动把它移动到A1:E5区域后的状态。

ggmmlol

把代码测试的第4个附件发上来：
窗口测试_窗体大小适合单元格区域.rar (20.02 KB, 下载次数: 154)

2018-2-5 11:30 上传

点击文件名下载附件

ggmmlol

然而，上面附件的代码，只适合活动工作簿的窗口显示比例为100%的整数倍的情况。
如果显示比例的值是一个小数，而且指定的区域的单元格的行数、列数较多时，上述代码运行的结果，窗体的大小与选定的单元格区域的大小相比较，会有较明显的偏差。

比如，先把整个工作表全部的行高调整为13个像素高，宽度调整为13个像素宽，再把窗口显示比例调整为50%，并且把指定的单元格区域扩大到A1:Z30再来测试代码
为此，需要把上面附件中的代码的2处需要对应修改一下。

其一，原来.Parent.Parent.Windows(1).Zoom = 100，替换成
.Parent.Parent.Windows(1).Zoom = 50
其二，原来 Range("A1:E5").Activate，替换成
Range("A1:Z30").Activate

其测试结果就如下图所示，大小的误差就非常明显：

ggmmlol

所以，接下来，我们需要对上面的代码做出改进，以便能够准确地适应工作簿窗口的显示比例不是100%时的情况。
而这时，就必须要用到前面介绍过的GDI相关的API函数来救场了！
代码的改进，包含以下几个步骤
1、先把制作异形窗体的那个附件中的API函数，及其参数用到的命名常数定义一起复制过来，GetDC，ReleaseDC，GetDeviceCaps。
2、然后添加两个Long型的全局变量PPI和IZoom，用于存储屏幕的分辨率（每英寸的像素个数）和窗口显示比例的百分值。
3、编写两个公用的过程:GetPPI和pt2Px，具体如下：

1. Sub GetPPI()
   
2.     Dim hDc As Long
   
3.     hDc = GetDC(0&)
   
4.     PPI = GetDeviceCaps(hDc, LOGPIXELSX)
   
5.     ReleaseDC 0&, hDc
   
6. End Sub
   
7. Function pt2px(ByVal x As Single)
   
8.     pt2px = WorksheetFunction.Round(WorksheetFunction.Round(x * PPI / 72, 0) * iZoom / 100, 0) '切记：这里一定不要使用VB的Round函数。
   
9. End Function

复制代码

再修改UserFormFitRange过程的代码如下：

1. Private Sub UserFormFitRange(ByVal oRng As Range)
   
2.     Dim lft, tp, wd, ht
   
3.     Dim i As Long
   
4.     GetPPI
   
5.     With oRng
   
6.         iZoom = .Parent.Parent.Windows(1).Zoom
   
7.         For i = 1 To .Columns.Count
   
8.             wd = wd + pt2px(.Columns(i).Width)
   
9.         Next
   
10.         For i = 1 To .Rows.Count
    
11.             ht = ht + pt2px(.Rows(i).Height)
    
12.         Next
    
13.     End With
    
14.    
    
15.     Unload UserForm1    '此步骤使窗体在下次显示时恢复默认风格，以便能够用鼠标来移动它。
    
16.                         '否则，如果窗体已经设为鼠标穿透的话，就不能用鼠标来移动它了
    
17.     With UserForm1
    
18.         .Width = wd / PPI * 72
    
19.         .Height = ht / PPI * 72
    
20.         .Show 0
    
21.     End With
    
22. End Sub

复制代码

现在，再次运行宏“窗体大小适合单元格区域”，看看结果，如下图所示：

用鼠标把窗体移动到A1单元格位置，如下图所示，可以看到，窗体的大小与所选定的区域范围是正好合适的。
这说明代码的改进，确实是成功了。

ggmmlol

又到了上传新代码测试的附件的时候了。
窗口测试_窗体大小适合单元格区域_改进.rar (27.45 KB, 下载次数: 173)

2018-2-5 15:42 上传

点击文件名下载附件

ggmmlol

接下来，《窗体“变形记”》就到了最关键的时候了，让窗体显示在指定的单元格区域上。
“等等”，有的朋友可能要求打住，因为他可能发现了问题：
1、窗体的标题还在，如果用来做行列的指示时，就这样让窗体的标题显示出来，还露着右上角关闭窗体用的“×”按钮，就也太丑陋了，能不能先去掉它啊？
2、如果指定的单元格区域是单个的，而且其面域较小的话，上面的代码并不能窗体的大小调整到同样小的程度。

嘿嘿，我说我是故意这么做的，你们信吗？
“当然不信！”“信你个鬼哟！”
“朋友们，先别骂，刚才我是开玩笑的。我保证，现在、立刻、马上，就去把这两个问题解决了！”

ggmmlol

话说上面示例中的窗体，顶着一个标题，拧劲儿就不愿意变形到一个小单元格的大小。
就好比电视栏目《变形记》里那些年轻的主人公一样，顶着杀马特的发型，不情愿去大山沟里小山村完成人生的变形。
所以，在让他去变形之前，实在应该先修剪掉他的杀马特的发型，让他从外观上先不抵触“变形”。

修剪掉一个杀马特发型，对于理发师来说，这不是什么问题。那么，我们要修剪掉窗体的标题栏，又如何呢？

答案是：同样很简单，因为——修改套用一句小品台词来回答：不会修剪杀马特发型的程序猿绝不是一个合格的厨子！

言归正传，修剪掉窗体的标题，还是需要使用SetWindowLongp 这个API函数，具体的代码是：

1. Function SetWindowNoCaption(ByVal lHwnd As Long) As Long
   
2.     Dim lStyle As Long, rvl As Long
   
3.     lStyle = GetWindowLong(lHwnd, GWL_STYLE) '取得窗体原有风格
   
4.     lStyle = lStyle And Not WS_CAPTION And Not WS_BORDER '预设窗体无标题、无边框风格
   
5.     SetWindowNoCaption = SetWindowLong(lHwnd, GWL_STYLE, lStyle) '对窗体应用预设的风格
   
6. End Function

复制代码

ggmmlol

《窗体“变形记”》第二集播放完毕了。
还是用附件来验证前面所述代码是否正确：
窗口测试_窗体大小适合单元格区域_改进2.rar (29.91 KB, 下载次数: 181)

2018-2-5 19:32 上传

点击文件名下载附件

liucqa

写得很详细，再支持一下