vba 如何阻止 ActiveX 对象在 office 中自动更改大小？

How to stop ActiveX objects automatically changing size in office?

提问by enderland

This threaddiscusses a problem I've been having with ActiveX objects in an Excel spreadsheet. It's a mess to read through and ultimately doesn't have a cohesive answer.

该线程讨论了我在 Excel 电子表格中使用 ActiveX 对象时遇到的问题。通读一遍是一团糟，最终没有一个有凝聚力的答案。

The problem is 100% reproduceable:

问题是 100% 可重现的：

1. Open workbook with ActiveX objects in spreadsheet while using a docking station
2. Disconnect machine from docking station, triggering a resolution change (there are other causes too, mine is with a docking station, it seems changing resolution causes this)
3. Click an ActiveX control - they immediately resize and the font changes size. The fontsize change is NOT a function of the .Font.Sizeparameter but something which cannot be changed after the problem occurs, other than continually increasing the fontsize

1. 使用扩展坞打开电子表格中包含 ActiveX 对象的工作簿
2. 断开机器与扩展坞的连接，触发分辨率更改（也有其他原因，我的是扩展坞，似乎更改分辨率会导致此问题）
3. 单击 ActiveX 控件 - 它们会立即调整大小并且字体会更改大小。字体大小的变化不是.Font.Size参数的函数，而是出现问题后无法更改的东西，除了不断增加字体大小

The only seemingly authoritative solution involves a MS patch (it was a "hotfix" several years ago, though, so it doesn't seem practical for full deployment) and registry edits, which is not practical for my use case.

唯一看似权威的解决方案涉及 MS 补丁（尽管它是几年前的“修补程序”，但对于完全部署似乎并不实用）和注册表编辑，这对我的用例来说并不实用。

I am looking for a way to either:

我正在寻找一种方法：

1. Prevent this change from occuring
2. Find the best work around

1. 防止发生这种变化
2. 找到最好的解决方法

There is a lack of authoritative information on this problem online. I am intending to post my work around, however, it is not even close to ideal and I would much prefer a better solution.

关于这个问题，网上缺乏权威信息。我打算发布我的工作，但是，它甚至不接近理想状态，我更喜欢更好的解决方案。

采纳答案by enderland

My work around is to programmatically iterate through all OLE objects on the sheet* and write code to the debugger, then include a button basically "resize objects" on the sheet - with instructions on why this problem is occurring.

我的解决方法是以编程方式遍历工作表 * 上的所有 OLE 对象并将代码写入调试器，然后在工作表上包含一个基本上“调整对象大小”的按钮 - 并说明为什么会出现此问题。

This method will generate the code to drive that button.

此方法将生成驱动该按钮的代码。

It will not automatically update however - it is a snapshot and should onlybe used immediately prior to deployment of an app (if end users are going to have the button functionality).

但是，它不会自动更新——它是一个快照，只能在部署应用程序之前立即使用（如果最终用户将拥有按钮功能）。

The sequence then becomes:

然后序列变为：

1. Run code generated with following method
2. Save workbook immediately - this does NOT prevent the font changes from continuing to occur
3. Reopen workbook and problem is "solved"

1. 运行使用以下方法生成的代码
2. 立即保存工作簿 - 这不会阻止字体更改继续发生
3. 重新打开工作簿，问题就“解决了”

---

---

Private Sub printAllActiveXSizeInformation()
    Dim myWS As Worksheet
    Dim OLEobj As OLEObject
    Dim obName As String
    Dim shName As String

    'you could easily set a for/each loop for all worksheets
    Set myWS = Sheet1

    shName = myWS.name

    Dim mFile As String
    mFile = "C:\Users\you\Desktop\ActiveXInfo.txt"


    Open mFile For Output As #1
    With myWS
        For Each OLEobj In myWS.OLEObjects
            obName = OLEobj.name

            Print #1, "'" + obName
            Print #1, shName + "." + obName + ".Left=" + CStr(OLEobj.Left)
            Print #1, shName + "." + obName + ".Width=" + CStr(OLEobj.Width)
            Print #1, shName + "." + obName + ".Height=" + CStr(OLEobj.Height)
            Print #1, shName + "." + obName + ".Top=" + CStr(OLEobj.Top)
            Print #1, "ActiveSheet.Shapes(""" + obName + """).ScaleHeight 1.25, msoFalse, msoScaleFromTopLeft"
            Print #1, "ActiveSheet.Shapes(""" + obName + """).ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft"

        Next OLEobj
    End With

    Close #1

    Shell "NotePad " + mFile



End Sub

*note: this will not find objects which are grouped, unfortunately, either.

*注意：不幸的是，这也不会找到分组的对象。

回答by stenci

The only 100% reliable workaround is to close and restart Excel (including any invisible instances). Any other solution has some problem.

唯一 100% 可靠的解决方法是关闭并重新启动 Excel（包括任何不可见的实例）。任何其他解决方案都有一些问题。

That's one of the reasons why I avoid controls when possible. See herefor an example.

这就是我尽可能避免控制的原因之一。有关示例，请参见此处。

回答by Rui Honorio

This module was Created by dlmille of E-E March 20, 2011

本模块由 EE 的 dlmille 于 2011 年 3 月 20 日创建

This is an exercise to store active-x control settings in a workbook, on a sheet basis, preserving their settings if/when Excel gets "quirky" and shape sizes go askew While the ListBox has an IntegralHeight property whose side-affect of a FALSE setting will keep that control from going askew, and while command buttons have properties such as move/size with cells, etc., other controls are not as graceful.

这是一个练习，将 active-x 控件设置存储在工作簿中，在工作表的基础上，如果/当 Excel 变得“古怪”并且形状大小歪斜时保留它们的设置虽然 ListBox 有一个 IntegralHeight 属性，其副作用为 FALSE设置将防止该控件歪斜，虽然命令按钮具有移动/大小与单元格等属性，但其他控件并不那么优雅。

The routine setControlsOnSheet(): 1) obtains the 6 common control settings, for every OLEObject (active-x) control on the active sheet, and 2) stores those settings into a string array, sControlSettings(), and 3) adds/updates a defined name (which is hidden) with those settings.

例程 setControlsOnSheet()：1) 为活动工作表上的每个 OLEObject (active-x) 控件获取 6 个常用控件设置，以及 2) 将这些设置存储到字符串数组 sControlSettings() 中，以及 3) 添加/更新具有这些设置的定义名称（隐藏）。

The defined name for each control on a sheet is built up based on the active sheet name and the control name (which should create a unique instance)

工作表上每个控件的定义名称基于活动工作表名称和控件名称（应创建唯一实例）

Process: The user creates whatever controls are going to be on the worksheet, and at any point, the setControlsOnSheet() routine can be run, to either initially store the settings for all controls, refresh those settings, or add new settings (as it does this for every control on the sheet).

过程：用户在工作表上创建任何控件，并且在任何时候，都可以运行 setControlsOnSheet() 例程，以最初存储所有控件的设置、刷新这些设置或添加新设置（因为它对工作表上的每个控件执行此操作）。

Care should be taken to ensure all settings "look right" (e.g., Excel has as yet to get "quirky", or the user has just adjusted one to many of his controls and is ready to "save" their settings. Otherwise, any improperly sized controls' settings would get stored.

应注意确保所有设置“看起来都正确”（例如，Excel 尚未变得“古怪”，或者用户刚刚调整了一个或多个控件并准备“保存”他们的设置。否则，任何大小不正确的控件设置将被存储。

Rather than make this routine process intensive, the ThisWorkbook event for sheet activate will "reinitialize" all settings for all controls that exist on the sheet that was just selected. This way, the control settings on the sheet are "restored" to their most recently saved settings, thus "forever?" avoiding the Excel "quirky" resizing consequence.

工作表激活的 ThisWorkbook 事件将“重新初始化”刚刚选择的工作表上存在的所有控件的所有设置，而不是使此例行过程变得密集。这样，工作表上的控制设置将“恢复”为最近保存的设置，因此“永远？” 避免 Excel“古怪”调整大小的后果。

As a potential enhancement, this app could be embedded in a class module as part of an add-in, thus keeping any related code out of the users "normal" programming environment. E.g., the sheet activate event trapping would be captured in the class module, rather than the user having to add it to his/her ThisWorkbook module.

作为一项潜在的增强功能，该应用程序可以作为插件的一部分嵌入到类模块中，从而将任何相关代码排除在用户“正常”编程环境之外。例如，表单激活事件捕获将在类模块中捕获，而不是用户必须将其添加到他/她的 ThisWorkbook 模块中。

Const CONTROL_OPTIONS = "Height;Left;Locked;Placement;Top;Width" 'some potentially useful settings to store and sustain

Function refreshControlsOnSheet(sh As Object)'routine enumerates all objects on the worksheet (sh), determines which have stored settings, then refreshes those settings from storage (in the defined names arena)

Dim myControl As OLEObject
Dim sBuildControlName As String
Dim sControlSettings As Variant

For Each myControl In ActiveSheet.OLEObjects
    sBuildControlName = "_" & myControl.Name & "_Range" 'builds a range name based on the control name
    'test for existance of previously-saved settings
    On Error Resume Next
    sControlSettings = Evaluate(sBuildControlName) 'ActiveWorkbook.Names(sBuildControlName).RefersTo 'load the array of settings
    If Err.Number = 0 Then ' the settings for this control are in storage, so refresh settings for the control
        myControl.Height = sControlSettings(1)
        myControl.Left = sControlSettings(2)
        myControl.Locked = sControlSettings(3)
        myControl.Placement = sControlSettings(4)
        myControl.Top = sControlSettings(5)
        myControl.Width = sControlSettings(6)
    End If
    Err.Clear
    On Error GoTo 0
Next myControl      
End Function

Private Sub storeControlSettings(sControl As String)
Dim sBuildControlName As String
Dim sControlSettings(1 To 6) As Variant ' set to the number of control settings to be stored
Dim oControl As Variant

Set oControl = ActiveSheet.OLEObjects(sControl)

'store the settings to retain, so they can be reset on demand, thus avoiding Excel's resizing "problem"
'create array of settings to be stored, with order dictated by CONTROL_OPTIONS for consistency/documentation

sControlSettings(1) = oControl.Height
sControlSettings(2) = oControl.Left
sControlSettings(3) = oControl.Locked
sControlSettings(4) = oControl.Placement
sControlSettings(5) = oControl.Top
sControlSettings(6) = oControl.Width


sBuildControlName = "_" & sControl & "_Range" 'builds a range name based on the control name

Application.Names.Add Name:="'" & ActiveSheet.Name & "'!" & sBuildControlName, RefersTo:=sControlSettings, Visible:=False 'Adds the control's settings to the defined names area and hides the range name
End Sub


Public Sub setControlsOnSheet()
Dim myControl As OLEObject

If vbYes = MsgBox("If you click 'Yes' the settings for all controls on your active worksheet will be stored as they CURRENTLY exist. " & vbCrLf & vbCrLf _
                & "Are you sure you want to continue (any previous settings will be overwritten)?", vbYesNo, "Store Control Settings") Then

    For Each myControl In ActiveSheet.OLEObjects 'theoretically, one could manage settings for all controls of this type...
        storeControlSettings (myControl.Name)
    Next myControl

    MsgBox "Settings have have been stored", vbOKOnly
End If
Application.EnableEvents = True 'to ensure we're set to "fire" on worksheet changes
End Sub

回答by Steven Good

I think @RuiHonori had the best answer, but in order for me to get my controls on all my sheets to where i wanted them to be - which all happened to be the same size - I used this:

我认为@RuiHonori 有最好的答案，但为了让我将所有工作表上的控件控制到我想要的位置——它们恰好是相同的大小——我使用了这个：

Sub SizeControls()
    Dim myControl As OLEObject
    Dim WS As Worksheet
    For Each WS In ThisWorkbook.Worksheets
        For Each myControl In WS.OLEObjects
            myControl.Height = 42.75
            myControl.Width = 96
        Next myControl
    Next WS
End Sub

回答by tbaker818

I had several issues with the buttons, font size being one of them. I also had buttons resizing and the pictures within them resizing. I could programatically change the button size back, but couldn't find a way to change the picture size that way. I think I've found what may be the ultimate solution to these problems.

我有几个按钮问题，字体大小就是其中之一。我还调整了按钮大小，并调整了其中的图片大小。我可以以编程方式更改按钮大小，但找不到以这种方式更改图片大小的方法。我想我已经找到了这些问题的最终解决方案。

If I delete the MSForms.exd file from (in my case) C:\Users{UserName}\AppData\Local\Temp\Excel8.0 while you're in the screen resolution you'd like to view the buttons in and then restart Excel, these problems seem to vanish. There are other .exd files you may need to delete for other applications. Some of them are:

如果我从（在我的情况下）C:\Users{UserName}\AppData\Local\Temp\Excel8.0 中删除 MSForms.exd 文件，而您在屏幕分辨率下，您希望在其中查看按钮，然后重新启动Excel，这些问题似乎都消失了。您可能需要为其他应用程序删除其他 .exd 文件。他们之中有一些是：

C:\Users\[user.name]\AppData\Local\Temp\Excel8.0\MSForms.exd

C:\Users\[user.name]\AppData\Local\Temp\VBE\MSForms.exd

C:\Users\[user.name]\AppData\Local\Temp\Word8.0\MSForms.exd

There's one for PowerPoint as well, but I can't seem to locate the related support document (which does not really call out these specific problems as far as I can remember)

PowerPoint 也有一个，但我似乎找不到相关的支持文档（据我所知，它并没有真正指出这些具体问题）

回答by Gary's Student

Similar problems exist for Comments and Shapes. One workaround is to write a macro to record the .Widthand .Heightproperties as well as the sheet position properties of each object on an unused worksheet. Then write a second macro to re-establish these properties on demand.

注释和形状也存在类似的问题。一种解决方法是编写一个宏来记录未使用的工作表上每个对象的.Width和.Height属性以及工作表位置属性。然后编写第二个宏以根据需要重新建立这些属性。

回答by Xeliax

This was happening to me in the past (after or while using a distant connection to my PC), but I had come up with a solution to resize the commandbuttons and their fonts using the Workbook_WindowActivateevent (this could be done through a "reset settings" button as well I suppose).

这在过去发生在我身上（在使用远程连接到我的 PC 之后或同时），但我想出了一个解决方案来使用Workbook_WindowActivate事件调整命令按钮及其字体的大小（这可以通过“重置设置”来完成）按钮以及我想）。

Anyhow, I thought all was fixed until today when I used again a distant connection and two commandbuttons started to misbehave. I found out that those 2 commandbuttons had the Placement property set to 2 (Object is moved with the cells) while I had set it to 3 (Object is free floating) for the others in the past.

无论如何，直到今天我再次使用远程连接并且两个命令按钮开始行为不端时，我认为一切都已解决。我发现这 2 个命令按钮的 Placement 属性设置为 2（对象随单元格移动），而我过去将其设置为 3（对象自由浮动）。

But before finding this, I was trying to set the font size of the buttons to what I wanted (through the properties window), but Windows was disregarding any number I was using, up until I changed the height of the button... all of a sudden it read the font size property and adjusted it accordingly.

但在找到这个之前，我试图将按钮的字体大小设置为我想要的（通过属性窗口），但 Windows 忽略了我使用的任何数字，直到我改变了按钮的高度......所有突然它读取字体大小属性并相应地调整它。

I am not sure if the placement property is actually part of the issue, but just to be sure, I use the 2 solutions:

我不确定放置属性是否真的是问题的一部分，但可以肯定的是，我使用了两种解决方案：

(1) placement is set to 3

(1) 放置设置为 3

(2) my "auto-resize" function that triggers with the Workbook_WindowActivateevent increases the button and font size a little before reducing them back to what they should. But maybe solution (1) would be sufficient... I have no time to test right now. Here's the code for my Workbook_Activateevent:

(2) 随Workbook_WindowActivate事件触发的“自动调整大小”功能会稍微增加按钮和字体大小，然后再将它们减少回应有的大小。但也许解决方案 (1) 就足够了……我现在没有时间进行测试。这是我的Workbook_Activate活动的代码：

Worksheets(1).Shapes("CommandButton1").Top = 0
Worksheets(1).Shapes("CommandButton1").Left = 206.25
Worksheets(1).Shapes("CommandButton1").Width = 75
Worksheets(1).OLEObjects(1).Object.Font.Size = 10
Worksheets(1).Shapes("CommandButton1").Height = 21
Worksheets(1).Shapes("CommandButton1").Height = 18.75
Worksheets(1).OLEObjects(1).Object.Font.Size = 8

Now all works fine. Took me some time in the past to find a solution on the net. I hope this will help at least one person out there ;-)

现在一切正常。过去花了我一些时间在网上找到解决方案。我希望这会帮助至少一个人;-)