Excel vba убрать заголовок формы

Хитрости »

1 Март 2016              17034 просмотров

Иногда при разработке интерфейсов программы с помощью форм пользователя(UserForm) бывает необходимо запретить закрытие формы крестиком. Причин много: например на форме много элементов выбора и пользователь не должен просто закрывать форму крестиком, не выбрав что-то конкретное. Или может форма должна висеть постоянно на листе до тех пор, пока программа не сделает все необходимые действия и т.д.
Варианта два
Вариант 1
Можно просто запретить закрывать форму. Это значит, что после нажатия на крестик ничего не произойдет. Для этого надо перейти в модуль формы и на событие 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

Теперь при попытке закрыть форму крестиком пользователь увидит сообщение с инструкцией.

Вариант 2
Но порой надо не просто запретить закрывать форму — но и для эстетики убрать заголовок с крестиком вообще — чтобы не смущал пользователя. Здесь чуть посложнее — придется применить функции 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.

ВАЖНО: Применяя любой из подходов советую заранее продумать как форма будет вообще закрываться, в том числе в режиме отладки программы. Т.к. если просто вставить этот код, то сами же не сможете закрыть форму — только завершением выполнения кода через Run —Reset.

Во вложении найдете все описанные варианты отображения форм:

  Tips_Macro_DontCloseFormOnMenu.xls (77,5 KiB, 1 902 скачиваний)

Статья помогла? Поделись ссылкой с друзьями!

    Видеоуроки

Поиск по меткам



Access
apple watch
Multex
Power Query и Power BI
VBA управление кодами
Бесплатные надстройки
Дата и время
Записки
ИП
Надстройки
Печать
Политика Конфиденциальности
Почта
Программы
Работа с приложениями
Разработка приложений
Росстат
Тренинги и вебинары
Финансовые
Форматирование
Функции Excel
акции MulTEx
ссылки
статистика

Remove the Title Bar and border from a form, including the red X, or close button.

This creates a clean UserForm interface and is great for things like splash pages or just giving your forms a cleaner and more streamlined appearance.

Sections:

Remove Title Bar from UserForm

Notes

Remove Title Bar from UserForm

To remove the title bar and border, we need to add VBA code into a regular module and then call that code from the UserForm_Initialize event, which is what runs when a form is opened.

Module Code

The below code goes into a regular module in the VBA window. (Alt + F11 to get to the VBA window and then Insert > Module.)

Option Explicit

#If VBA7 Then
    Public Declare PtrSafe Function FindWindow Lib "user32" _
                Alias "FindWindowA" _
               (ByVal lpClassName As String, _
                ByVal lpWindowName As String) As Long


    Public Declare PtrSafe Function GetWindowLong Lib "user32" _
                Alias "GetWindowLongA" _
               (ByVal hWnd As Long, _
                ByVal nIndex As Long) As Long


    Public Declare PtrSafe Function SetWindowLong Lib "user32" _
                Alias "SetWindowLongA" _
               (ByVal hWnd As Long, _
                ByVal nIndex As Long, _
                ByVal dwNewLong As Long) As Long


    Public Declare PtrSafe Function DrawMenuBar Lib "user32" _
               (ByVal hWnd As Long) As Long
#Else
    Public Declare Function FindWindow Lib "user32" _
                Alias "FindWindowA" _
               (ByVal lpClassName As String, _
                ByVal lpWindowName As String) As Long


    Public Declare Function GetWindowLong Lib "user32" _
                Alias "GetWindowLongA" _
               (ByVal hWnd As Long, _
                ByVal nIndex As Long) As Long


    Public Declare Function SetWindowLong Lib "user32" _
                Alias "SetWindowLongA" _
               (ByVal hWnd As Long, _
                ByVal nIndex As Long, _
                ByVal dwNewLong As Long) As Long


    Public Declare Function DrawMenuBar Lib "user32" _
               (ByVal hWnd As Long) As Long
#End If

Note: this code must go at the very top of the module before any other code!

The next section of code can be placed anywhere within the module.

Sub HideBar(frm As Object)

Dim Style As Long, Menu As Long, hWndForm As Long
hWndForm = FindWindow("ThunderDFrame", frm.Caption)
Style = GetWindowLong(hWndForm, &HFFF0)
Style = Style And Not &HC00000
SetWindowLong hWndForm, &HFFF0, Style
DrawMenuBar hWndForm

End Sub

UserForm Code

Code must also be placed within the UserForm itself in order to work.

All you need to do is call HideBar and pass it a reference to the form.

HideBar Me

This piece of code should be placed inside the UserForm_Initialize event. This event will usually have other code inside of it, but the most basic version of the event for this example could look like this:

Private Sub UserForm_Initialize()

'Remove Border and Title Bar
HideBar Me

End Sub

To learn more about the Initialize event and events in general, view our tutoral on UserForm Events.

Notes

Removing the title bar removes the default close button on the form; as such, you should place a button somehwere on the form that will allow the user to close it.

This also removes the ability to move the form around the window with your mouse; as such, you should think about this before implementing this code or you should use additional code that allows the user to move the form by clicking on it and dragging it without a title bar.

This code works great with splash screens in Excel but you can use it any time you want your form to have a more streamlined look.

Don’t forget to download the sample file to see this example in Excel.

Similar Content on TeachExcel

Creating a Splash Screen in Excel

Tutorial: Create a pop-up window, splash screen, that appears when Excel starts.
This allows you to …

Getting Data from a UserForm

Tutorial: How to get data from a UserForm in Excel, including from: text inputs (TextBox), list boxe…

Subscribe for Weekly Tutorials

BONUS: subscribe now to download our Top Tutorials Ebook!

Option Explicit
 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex 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 Const GWL_STYLE = (-16)
Private Const WS_BORDER As Long = &H800000
Private Const WS_CAPTION As Long = &HC00000
 
Public Sub ChangeWindow(f As UserForm)
  Dim hwnd As Long
  Dim retval As Long
  hwnd = FindWindow("ThunderDFrame", f.Caption)
  If hwnd <> 0 Then
    retval = SetWindowLong(hwnd, GWL_STYLE, GetWindowLong(hwnd, GWL_STYLE) And WS_BORDER)
  End If
  If retval = 0 Then MsgBox "Fail"
End Sub
 
Private Sub UserForm_Initialize()
  ChangeWindow Me
End Sub

Вернуться в VBA

Кто сейчас на конференции

Сейчас этот форум просматривают: PetalBot и гости: 3