VBA - объект ошибки 438 не поддерживает ... CenterAlign заголовки командных кнопок - PullRequest
0 голосов
/ 02 октября 2019

Я получаю сообщение об ошибке 438 "Скриншот объекта не поддерживает свойство ..." ниже. Мой код ниже: Цель состоит в том, чтобы выровнять заголовок / текст всех командных кнопок в пользовательской форме1. Почему я получаю эту ошибку? Как это исправить?

Option Explicit

         '<<<<<<<<<<< Adapted from http://www.freevbcode.com/ShowCode.asp?ID=330

#If VBA7 Then
      Private Declare PtrSafe Function GetWindowLong& Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long)
      Private Declare PtrSafe Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)
#Else
      Private Declare Function GetWindowLong& Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long)
      Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)
#End If

'--------------------------------------------

Public Enum BUTTON_STYLE
    BS_CENTER = &H300&
    BS_LEFT = &H100&
    BS_RIGHT = &H200&
    BS_TOP = &H400&
End Enum

'--------------------------------------------

Private Const GWL_STYLE& = (-16)

Public Sub AlignCommandButtonText(Button As Object, Style As BUTTON_STYLE)
      Dim lHwnd As Long
      On Error Resume Next
      lHwnd = Button.hwnd
      Dim lWnd As Long
      Dim lRet As Long
      If lHwnd = 0 Then Exit Sub
      lWnd = GetWindowLong(lHwnd, GWL_STYLE)
      lRet = SetWindowLong(Command1.hwnd, GWL_STYLE, Style Or lWnd)
      Button.Refresh
End Sub


'--------------------------------------------

Public Sub CenterAlignButtons()
    For Each control_Object In UserForm1.Controls
       If TypeName(control_Object) = "CommandButton" Then
         Set Button = control_Object
         Button.Refresh        '<<<<<<< This method of calling is wrong, causing the error...?
         DoEvents
       End If
    Next
End Sub

'--------------------------------------------

Ошибка 438 ...

Перед запуском кода языка

После запуска кода языка

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...