Excel: the Incredible Shrinking and Expanding Controls

前端 未结 30 2030
予麋鹿
予麋鹿 2020-11-28 04:51

Occasionally, I\'ll happen across a spreadsheet which suffers from magic buttons or listboxes which get bigger or smaller over time.

Nothing in the code is instructi

30条回答
  •  遥遥无期
    2020-11-28 05:24

    We just solved this on a company level by adding the following module to all macro enabled workbooks:

    Option Explicit
    
    Type ButtonSizeType
        topPosition As Single
        leftPosition As Single
        height As Single
        width As Single
    End Type
    
    Public myButton As ButtonSizeType
    
    Sub GetButtonSize(cb As MSForms.CommandButton)
    ' Save original button size to solve windows bug that changes the button size to
    ' adjust to screen resolution, when not in native resolution mode of screen
        myButton.topPosition = cb.top
        myButton.leftPosition = cb.Left
        myButton.height = cb.height
        myButton.width = cb.width
    End Sub
    
    Sub SetButtonSize(cb As MSForms.CommandButton)
    ' Restore original button size to solve windows bug that changes the button size to
    ' adjust to screen resolution, when not in native resolution mode of screen
        cb.top = myButton.topPosition
        cb.Left = myButton.leftPosition
        cb.height = myButton.height
        cb.width = myButton.width
    End Sub
    

    Just call them in the beginning and end of your code like this:

    Private Sub CommandButton1_Click()
    
    Application.ScreenUpdating = False
    ' Turn off ScreenUpdating to make sure the user dosn't see the buttons flicker
    GetButtonSize CommandButton1 ' Saves original button size
    ' Do cool things
    '
    '
    '
    SetButtonSize CommandButton1 ' Restores original button size
    
    Application.ScreenUpdating = True
    ' Turn ScreenUpdating back on when you're done
    End Sub
    

提交回复
热议问题