vba - How to stop ActiveX objects automatically changing size in office?

Question

This thread discusses 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.

The problem is 100% reproduceable:

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.Size parameter but something which cannot be changed after the problem occurs, other than continually increasing the fontsize

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.

I am looking for a way to either:

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

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.

Answer 1

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.

This method will generate the code to drive that button.

It will not automatically update however - it is a snapshot and should only be 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"

---

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:UsersyouDesktopActiveXInfo.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.