Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Как программно уменьшить ширину формы? - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как программно уменьшить ширину формы? (Макросы/Sub)
Как программно уменьшить ширину формы?
damask_86ru Дата: Понедельник, 01.06.2015, 10:04 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 60
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010
Всем привет!
У меня такой вопрос: необходимо сделать форму шириной (Width = 54), а в настройках формы данный параметр невозможно сделать меньше значения "99". Как программно уменьшить ширину формы?
 
Ответить
СообщениеВсем привет!
У меня такой вопрос: необходимо сделать форму шириной (Width = 54), а в настройках формы данный параметр невозможно сделать меньше значения "99". Как программно уменьшить ширину формы?

Автор - damask_86ru
Дата добавления - 01.06.2015 в 10:04
Manyasha Дата: Понедельник, 01.06.2015, 10:24 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
damask_86ru, здравствуйте:[vba]
Код
Private Sub UserForm_Initialize()
     Me.Width = 54'ширина
     Me.Height = 50'высота
End Sub
[/vba]Но у меня и в параметрах уменьшается до любого размера...
Если не поможет, приложите файл с формой.


ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеdamask_86ru, здравствуйте:[vba]
Код
Private Sub UserForm_Initialize()
     Me.Width = 54'ширина
     Me.Height = 50'высота
End Sub
[/vba]Но у меня и в параметрах уменьшается до любого размера...
Если не поможет, приложите файл с формой.

Автор - Manyasha
Дата добавления - 01.06.2015 в 10:24
damask_86ru Дата: Понедельник, 01.06.2015, 11:07 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 60
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010
Manyasha, здраствуйте!
У меня ничего не выходит (. Файл во вложении. Использую Excel 2003 и 2007.
К сообщению приложен файл: 6323274.xls (35.5 Kb)
 
Ответить
СообщениеManyasha, здраствуйте!
У меня ничего не выходит (. Файл во вложении. Использую Excel 2003 и 2007.

Автор - damask_86ru
Дата добавления - 01.06.2015 в 11:07
AndreTM Дата: Понедельник, 01.06.2015, 12:32 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 1762
Репутация: 500 ±
Замечаний: 0% ±

2003 & 2010
Похоже, здесь не обойтись без использования 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


Skype: andre.tm.007
Donate: Qiwi: 9517375010


Сообщение отредактировал AndreTM - Понедельник, 01.06.2015, 13:38
 
Ответить
СообщениеПохоже, здесь не обойтись без использования 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

Автор - AndreTM
Дата добавления - 01.06.2015 в 12:32
damask_86ru Дата: Вторник, 02.06.2015, 15:45 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 60
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010
AndreTM, простите, но что то не могу ничего сообразить. Вы не могли бы подсказать, как именно можно изменить ширину с помощью данного кода? Как я вижу и понимаю, можно изменить отступы слева и сверху, а так же изменить высоту формы.
Вот мой код в форме:

[vba]
Код
Private Const GWL_STYLE As Long = -16&
Private Const GWL_EXSTYLE = -20&

Private Const WS_CAPTION As Long = &HC00000
Private Const WS_BORDER As Long = &H800000
Private Const WS_EX_LAYERED = &H80000
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_FRAMECHANGED = &H20
Private Const SWP_NOOWNERZORDER = &H200
Private Const SWP_NOZORDER = &H4
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

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

SetWindowLong ghWnd_Info, GWL_STYLE, iStyle
SetWindowLong ghWnd_Info, GWL_EXSTYLE, 0
DrawMenuBar ghWnd_Info

'регулируем ширину формы
'-------------------------------------------------------------------
ihWnd = FindWindow(vbNullString, Me.Caption)
SetWindowPos ihWnd, 0, Me.Left, Me.Top, Me.Width, Me.Height, 0

End Sub
[/vba]


Сообщение отредактировал Serge_007 - Вторник, 02.06.2015, 17:40
 
Ответить
СообщениеAndreTM, простите, но что то не могу ничего сообразить. Вы не могли бы подсказать, как именно можно изменить ширину с помощью данного кода? Как я вижу и понимаю, можно изменить отступы слева и сверху, а так же изменить высоту формы.
Вот мой код в форме:

[vba]
Код
Private Const GWL_STYLE As Long = -16&
Private Const GWL_EXSTYLE = -20&

Private Const WS_CAPTION As Long = &HC00000
Private Const WS_BORDER As Long = &H800000
Private Const WS_EX_LAYERED = &H80000
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_FRAMECHANGED = &H20
Private Const SWP_NOOWNERZORDER = &H200
Private Const SWP_NOZORDER = &H4
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

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

SetWindowLong ghWnd_Info, GWL_STYLE, iStyle
SetWindowLong ghWnd_Info, GWL_EXSTYLE, 0
DrawMenuBar ghWnd_Info

'регулируем ширину формы
'-------------------------------------------------------------------
ihWnd = FindWindow(vbNullString, Me.Caption)
SetWindowPos ihWnd, 0, Me.Left, Me.Top, Me.Width, Me.Height, 0

End Sub
[/vba]

Автор - damask_86ru
Дата добавления - 02.06.2015 в 15:45
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как программно уменьшить ширину формы? (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!