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

讨论我在Excel电子表格中遇到的ActiveX对象问题。通读起来很混乱，最终没有一个连贯的答案

问题是100%可复制的：

使用扩展底座时在电子表格中打开包含ActiveX对象的工作簿

断开机器与扩展底座的连接，触发分辨率更改（还有其他原因，我的是扩展底座，似乎是分辨率更改导致的）

单击ActiveX控件-它们会立即调整大小并更改字体大小。fontsize更改不是

.Font.Size

参数的函数，而是问题发生后无法更改的函数，而不是不断增加fontsize

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

我正在寻找一种方法：

防止发生这种变化

找到最好的工作

---

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

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

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

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

然后，顺序变为：

运行使用以下方法生成的代码

立即保存工作簿-这不会阻止字体更改继续发生

重新打开工作簿，问题已“解决”

---

---

*注意：很遗憾，这也找不到分组的对象。

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

这在过去发生在我身上（在使用远程连接到我的电脑后或使用远程连接时），但我想出了一个解决方案，使用

工作簿\u WindowActivate

事件调整命令按钮及其字体的大小（这可以通过“重置设置”完成）我想也是这样）

不管怎样，直到今天我再次使用远程连接，两个CommandButton开始出现问题时，我还以为一切都已修复。我发现这2个commandbuttons的Placement属性设置为2（对象随单元格一起移动），而我在过去为其他按钮将其设置为3（对象自由浮动）

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

我不确定placement属性是否确实是问题的一部分，但为了确定，我使用了两种解决方案：

（1） “放置”设置为3

（2） 我的“自动调整大小”功能通过

Workbook\u WindowActivate

事件触发，该功能会在将按钮和字体大小减小到所需大小之前稍微增加按钮和字体大小。但也许解决方案（1）就足够了。。。我现在没有时间考试。以下是我的

工作簿\u激活
事件的代码：

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

现在一切都好了。过去我花了一些时间在网上找到一个解决方案。我希望这至少能帮助一个人；-）
 唯一100%可靠的解决方法是关闭并重新启动Excel（包括任何不可见的实例）。任何其他解决方案都有一些问题

这就是我在可能的情况下避免控制的原因之一。请参见示例。
我对按钮有几个问题，字体大小就是其中之一。我还调整了按钮的大小，其中的图片也在调整大小。我可以通过编程将按钮大小更改回原来的大小，但找不到这样更改图片大小的方法。我想我已经找到了这些问题的最终解决办法

如果我从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
此模块由E-E的dlmille于2011年3月20日创建

这是一个练习，以图纸为基础将active-x控件设置存储在工作簿中，在Excel变得“古怪”且形状大小倾斜时保留其设置
而ListBox有一个IntegralHeight属性，其错误设置的副作用将防止控件倾斜，而命令按钮
如果控件具有诸如移动/调整单元格大小等属性，则其他控件就没有那么优雅了

例程setControlsOnSheet（）：
1） 获取激活图纸上每个对象（active-x）控件的6个常用控件设置，以及
2） 将这些设置存储到字符串数组、sControlSettings（）和
3） 使用这些设置添加/更新已定义的名称（隐藏）

将建立图纸上每个控件的定义名称
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

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

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