Как убрать заголовок у UserForm VBA
Иногда при разработке интерфейсов программы с помощью форм пользователя(UserForm) бывает необходимо запретить закрытие формы крестиком. Причин много: например на форме много элементов выбора и пользователь не должен просто закрывать форму крестиком, не выбрав что-то конкретное. Или может форма должна висеть постоянно на листе до тех пор, пока программа не сделает все необходимые действия и т.д.
Варианта два
Можно просто запретить закрывать форму. Это значит, что после нажатия на крестик ничего не произойдет. Для этого надо перейти в модуль формы и на событие QueryClose прописать такой код:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = 0 Then 'CloseMode = 0 - попытка закрыть форму крестиком Cancel = True 'даем VBA понять, что надо отменить закрытие формы End If End Sub |
данный код не даст закрыть форму нажатием на крестик, но если форма выгружается другими методами(вроде Unload) - форма закроется. За это отвечает параметр CloseMode, который может принимать следующие значения:
- 0 или vbFormControlMenu - попытка закрытия формы пользователем через элемент управления крестик
- 1 или vbFormCode - закрытие формы через выгрузку методом Unload
- 2 или vbAppWindows - завершение сеанса Windows(в кодах VBA практически не используется)
- 3 или vbAppTaskManager - завершение программы через диспетчер задач(в кодах VBA практически не используется)
Можно(скорее даже нужно!) дать понять пользователю, что он должен сделать что-то конкретное для закрытия формы и что крестиком это сделать нельзя, чтобы он не нервничал и не пытался завершить работу Excel через Clt+Alt+Delete;
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = 0 Then 'CloseMode = 0 - попытка закрыть форму крестиком MsgBox "Вы должны нажать на кнопку в центре, чтобы закрыть форму", vbInformation, "www.excel-vba.ru" Cancel = True 'даем VBA понять, что надо отменить закрытие формы End If End Sub |
Теперь при попытке закрыть форму крестиком пользователь увидит сообщение с инструкцией.
Но порой надо не просто запретить закрывать форму - но и для эстетики убрать заголовок с крестиком вообще - чтобы не смущал пользователя. Здесь чуть посложнее - придется применить функции API. Код надо будет помещать уже на инициализацию формы(событие Initialize), а не на закрытие(QueryClose). Следующий код необходимо будет поместить в самое начало модуля той формы, меню которой требуется убрать(первой строкой или сразу после строк деклараций, таких как Option Explicit, Option Base, Option Compare Text):
'константы для функций API 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 'определяет рамку формы 'Функции API, применяемые для поиска окна и изменения его стиля #If VBA7 Then Private Declare PtrSafe Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr Private Declare PtrSafe Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr Private Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr Private Declare PtrSafe Function DrawMenuBar Lib "User32" (ByVal hwnd As LongPtr) As Long #Else 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 FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function DrawMenuBar Lib "user32.dll" (ByVal hwnd As Long) As Long #End If |
Это константы и функции API, которые и будут делать основную работу по удалению меню. Теперь останется на событие инициализации формы применить все эти функции:
Private Sub UserForm_Initialize() Dim ihWnd, hStyle 'ищем окно формы среди всех открытых окон If Val(Application.Version) < 9 Then ihWnd = FindWindow("ThunderXFrame", Me.Caption) 'для Excel 97 Else ihWnd = FindWindow("ThunderDFrame", Me.Caption) 'для Excel 2000 и выше End If 'получаем информацию о найденном окне(стили и т.д.) hStyle = GetWindowLong(ihWnd, GWL_STYLE) 'назначаем переменной новый стиль для окна формы hStyle = hStyle And Not WS_CAPTION And Not WS_BORDER 'изменяем вид окна: убираем меню(заголовок) и рамку SetWindowLong ihWnd, GWL_STYLE, hStyle SetWindowLong ihWnd, GWL_EXSTYLE, 0 'перерисовываем форму, точнее строку меню(заголовка) DrawMenuBar ihWnd 'меняем размер формы, т.к. сделали смещение элементов формы вверх на высоту заголовка Me.Height = Me.Height + GWL_EXSTYLE End Sub |
Я постарался кратко описать действия с формой в комментариях, поэтому не буду дублировать это еще и отдельным текстом.
После этого кода форма получается более эстетичного вида:
С такой формой у пользователя точно не возникнет желания закрыть форму как-то в обход наших желаний. В коммерческих разработках такой подход будет более правильным. Однако здесь тоже есть недостаток: т.к. строка меню убирается полностью, то форму невозможно переместить при помощи мыши. В каких-то случаях это может мешать, а в каких-то наоборот быть преимуществом. Так или иначе это следует учитывать.
С легкой руки моего старого друга и модератора нашего форума ЮрияМ дополняю статью еще одним кодом. Если на запуск формы применить такой код:
Private Sub UserForm_Initialize() Dim ihWnd, hStyle 'ищем окно формы среди всех открытых окон If Val(Application.Version) < 9 Then ihWnd = FindWindow("ThunderXFrame", Me.Caption) 'для Excel 97 Else ihWnd = FindWindow("ThunderDFrame", Me.Caption) 'для Excel 2000 и выше End If 'получаем информацию о найденном окне(стили и т.д.) hStyle = GetWindowLong(ihWnd, -16&) 'убираем кнопку крестика SetWindowLong ihWnd, -16&, hStyle And Not &H80000 End Sub |
То заголовок будет и можно будет форму за него хватать и перемещать, но крестика на форме вообще не будет:
Для этого кода так(же как и для предыдущего) в модуле формы необходимо разместить приведенные выше функции API.
Во вложении найдете все описанные варианты отображения форм:
Tips_Macro_DontCloseFormOnMenu.xls (77,5 KiB, 2 033 скачиваний)
Статья помогла? Поделись ссылкой с друзьями!
Видеоуроки
Поиск по меткам
Access apple watch Multex Power Query и Power BI VBA управление кодами Бесплатные надстройки Дата и время Записки ИП Надстройки Печать Политика Конфиденциальности Почта Программы Работа с приложениями Разработка приложений Росстат Тренинги и вебинары Финансовые Форматирование Функции Excel акции MulTEx ссылки статистикаКомментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум
В 365 ёкселе по второму варианту при декларации API между иначе(Else) и концом (End If) - сплошная ошибка :(
Андрей, если Вы про то, что строка выделяется красным - то так и должно быть. Но это не будет считаться ошибкой компиляции, т.к. присутствует условие деклараций #IF, которое для обработки таких ошибок и предназначено.
даже если очень мешает этот кусок - просто выпили условие
if
else
end if
и красный кусок кода
если не принципиально иметь поддержку старших/младших версий
Хотелось бы адресно поблагодарить авторов кода, я так понимаю Дмитрия и ЮрияМ (в личку методы перечисления благодарности плиз)
порадовал файлик, GPT телеги несёт несусветную чушь, а тут всё более чем наглядно и мацабельно
в дремучие 1999-2005 развлекался VBA и умел делать это, но святохранимые наработки подверглись воздействию фактора "женщина с ведром"
попарился вспоминать как оно... короче спасли от головной боли парни, Спасибо!
ЗЫ в статье не хватает только, как запилить неотличимую от оригинала, но свою (полностью управляемую из VBA) кнопку запилить