Всем привет! У меня такой вопрос: необходимо сделать форму шириной (Width = 54), а в настройках формы данный параметр невозможно сделать меньше значения "99". Как программно уменьшить ширину формы?
Всем привет! У меня такой вопрос: необходимо сделать форму шириной (Width = 54), а в настройках формы данный параметр невозможно сделать меньше значения "99". Как программно уменьшить ширину формы?damask_86ru
Похоже, здесь не обойтись без использования WinAPI Вставьте этот код в модуль формы: [vba]
Код
Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private ihWnd As Long
Private Sub UserForm_Initialize() ihWnd = FindWindow(vbNullString, Me.Caption) SetWindowPos ihWnd, 0, Me.Left, Me.Top, 54, Me.Height, 0 End Sub
[/vba]Думаю, вы придумаете, как именно вам нужно управлять размерами формы...
Для 2003 уберите из деклараций функций PtrSafe и замените тип LongPtr на Long
[vba]
Код
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
[/vba]
Похоже, здесь не обойтись без использования WinAPI Вставьте этот код в модуль формы: [vba]
Код
Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private ihWnd As Long
Private Sub UserForm_Initialize() ihWnd = FindWindow(vbNullString, Me.Caption) SetWindowPos ihWnd, 0, Me.Left, Me.Top, 54, Me.Height, 0 End Sub
[/vba]Думаю, вы придумаете, как именно вам нужно управлять размерами формы...
Для 2003 уберите из деклараций функций PtrSafe и замените тип LongPtr на Long
[vba]
Код
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
AndreTM, простите, но что то не могу ничего сообразить. Вы не могли бы подсказать, как именно можно изменить ширину с помощью данного кода? Как я вижу и понимаю, можно изменить отступы слева и сверху, а так же изменить высоту формы. Вот мой код в форме:
[vba]
Код
Private Const GWL_STYLE As Long = -16& Private Const GWL_EXSTYLE = -20&
Private Type POINTAPI x As Long Y As Long End Type
Private Declare Function DrawMenuBar Lib "user32.dll" ( _ ByVal hWnd As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 'Private Declare Function AnimateWindow Lib "user32" (ByVal hWnd As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As Boolean Private Declare Function GetCursorPos& Lib "user32.dll" (lpPoint As POINTAPI) Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Private Declare Sub ReleaseCapture Lib "user32" () Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private ghWnd_Info As Long Private ihWnd As Long '------------------------------------------------------------------------------------------------------------------------------------------- ------------------------------------------------------------------------------------------ Private Sub UserForm_Activate()
'убираем рамку и элементы Windows '------------------------------------------------------------------- ghWnd_Info = FindWindow("ThunderDFrame", Me.Caption)
Dim iStyle As Long iStyle = GetWindowLong(ghWnd_Info, GWL_STYLE) iStyle = iStyle And Not WS_CAPTION And Not WS_BORDER
AndreTM, простите, но что то не могу ничего сообразить. Вы не могли бы подсказать, как именно можно изменить ширину с помощью данного кода? Как я вижу и понимаю, можно изменить отступы слева и сверху, а так же изменить высоту формы. Вот мой код в форме:
[vba]
Код
Private Const GWL_STYLE As Long = -16& Private Const GWL_EXSTYLE = -20&
Private Type POINTAPI x As Long Y As Long End Type
Private Declare Function DrawMenuBar Lib "user32.dll" ( _ ByVal hWnd As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 'Private Declare Function AnimateWindow Lib "user32" (ByVal hWnd As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As Boolean Private Declare Function GetCursorPos& Lib "user32.dll" (lpPoint As POINTAPI) Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Private Declare Sub ReleaseCapture Lib "user32" () Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private ghWnd_Info As Long Private ihWnd As Long '------------------------------------------------------------------------------------------------------------------------------------------- ------------------------------------------------------------------------------------------ Private Sub UserForm_Activate()
'убираем рамку и элементы Windows '------------------------------------------------------------------- ghWnd_Info = FindWindow("ThunderDFrame", Me.Caption)
Dim iStyle As Long iStyle = GetWindowLong(ghWnd_Info, GWL_STYLE) iStyle = iStyle And Not WS_CAPTION And Not WS_BORDER