Excel: the Incredible Shrinking and Expanding Controls

This problem is very frustrating, my experience is that the properties are usually set properly on the ActiveX objects. I've modified a UDF from above to just be able to run on any active sheet, this will set everything back the way it was before shrinking.

Public Sub ResizeAllOfIt()
Dim myCtrl As OLEObject

For Each myCtrl In ActiveSheet.OLEObjects

 Dim originalHeight
 Dim originalWidth

 originalWidth = myCtrl.width
 originalHeight = myCtrl.height

  myCtrl.height = originalHeight - 1 
  myCtrl.height = originalHeight 
  myCtrl.width = originalWidth

Next myCtrl

End Sub

I noticed that none of these answers anchor the control to a specific row and column. This has worked pretty cleanly for me as Rows/Columns tend to be more predictable than monitors' resolution.

The below sample basically "measures" where the object should go, then sets it there in the Worksheet_Activate code. In the below example, the button will always snap to covering D8:F10.

Private Sub Worksheet_Activate()
'Note this is done in the sheet code, not a Module.

   With Me.Shapes("CommandButton1")

       .Left = Me.Range("A1:C1").Width
       .Top = Me.Range("a1:a7").Height
       .Width = Me.Range("D1:F1").Width
       .Height = Me.Range("A8:a10").Height

   End With

End Sub

The result will appear as shown below:

I run across this issue all the time in Excel 2010 (Which always brings me back to this thread) and although I haven't found a fix 100%, I believe I have some information that can help others.

While tediously playing around with the buttons I discovered that DIFFERENT EVENTS for each object were causing different issues. For example,

• Button A - The size of the button would shrink on the MouseDown event
• Button B - The text would enlarge on the MouseMove event (But only after the button was clicked. AKA, I click a button, code executes, leave the mouse hovering over the button, and then as soon as I move the mouse the text would enlarge)
• Text input box A - The text would enlarge on the MouseUp event
• Text input box B - The text would enlarge on the LostFocus event

The only solution that works for me is to write code to reset the size/text for each object event that was causing the random resizing. Like so ...

Where MaterialNum is the name of the input box, and MouseDown is the event ...

Private Sub MaterialNum_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    ' Reset the size, font style, and size
    With Worksheets("QuoteForm").Shapes("MaterialNum")
        .Height = 21
        .Width = 101.25
        .Left = 972.75
        .Top = 87
        With .DrawingObject.Object.Font
            .Name = "Arial"
            .Size = 12
        End With
    End With

End Sub

In addition, I had to change a few options in Format Control (Right click object > Format Control):

• Size tab: Lock aspect ratio box is checked
• Properties tab: Print Object box is unchecked

Also, in the Object Properties pane (Right click object > Properties) I set TakeFocusOnClick to false

Yes, this is time consuming and tedious as it has to be done with each object, but it's the only fix that works for me (And it seems to be a quicker fix than waiting for Microsoft to fix this!!!). Hopefully it helps others.

I hope others find this helpful

I had a similar problem, however I found that it was quickly fixed by zooming the page in and out. Therefore, I added the below code onto the bottom of my Macro as a quick fix. I'm no Excel whizz but it seems to work ok. Change the bottom number should reflect your preferred zoom.

ActiveWindow.Zoom = 100
ActiveWindow.Zoom = 90

Now using Excel 2013 and this happens EVERY time I extend my display while Excel is running (and every time I remove the extension).

The fix I've started implementing is using hyperlinks instead of buttons and one to open a userform with all the other activeX controls on.

Some of these problems may be due to controls resizing themselves when populated. I tend to the turn the IntegralHeight property of controls such as list boxes from True (default) to False to prevent automated resizing of the control height at runtime.

Although there are clearly numerous reasons for this behavior, several answers point to issues with scaling and screen resolutions. One workaround is to use the following functions to resize and anchor the controls to a specific cell:

Sub ResizeCombo(ByRef cbo As Shape, ByVal rw As Long, ByVal cl As Long, ByVal wid As Long)        
    cbo.Height = Intake.Cells(rw, cl).Height - 1
    cbo.Top = Intake.Cells(rw, cl).Top + 1
    cbo.Left = Intake.Cells(rw, cl).Left + 1
    cbo.Width = wid    
End Sub

Sub ResizeCheckbox(ByRef cbo As Shape, ByVal rw As Long, ByVal cl As Long)
    cbo.Height = Intake.Cells(rw, cl).Height - 1
    cbo.Top = Intake.Cells(rw, cl).Top + 1
    cbo.Left = Intake.Cells(rw, cl).Left + 6
    cbo.Width = Intake.Cells(rw, cl).MergeArea.Width - 7        
End Sub

Sub ResizeCombos()
    ResizeCombo Intake.Shapes("School"), 11, 1, 144

    ResizeCheckbox Intake.Shapes("cbReading"), 70, 1

    ''ResizeCombo also works for option buttons
    ResizeCombo Intake.Shapes("obGenderMale"), 20, 8, 45
    ResizeCombo Intake.Shapes("obGenderFemale"), 20, 9,50

HOWEVER, recently this workaround stopped working. I've been banging against it for days until I discovered that the zoom level of the sheet had been adjusted to 105%! Resetting it to 100% resolved the problem. However what if the user needs a higher zoom level? I figured out that I can change the zoom after resizing and things stay where they were meant to. My calling function now looks like this:

Sub refresh()
    OldZoom = ActiveWindow.Zoom
    ActiveWindow.Zoom = 100
    Call ResizeCombos
    ActiveWindow.Zoom = OldZoom
End Sub

So far it is working!