Microsoft Excel:

  Таблицы и VBA. Справочник.
  Вопросы и Ответы. Советы. Примеры.
Меню FAQ | Макросы | WinAPI


Rambler's Top100


Counter CO.KZ


Комментарий : Все приведённые примеры актуальны только для 32-bit. Обладателям же 64-bit, необходимо изменить об'явления WinAPI функций. Сделать это поможет статья, опубликованная на официальном сайте Microsoft Совместимость 32- и 64-разрядных версий Office 2010 и файл Win32API_PtrSafe.txt, который можно скачать там же.



    [0] [1] [2] [3]

  1. Как в MS Excel 97 отобразить нестандартное диалоговое окно в немодальном режиме ? 29.07.2007
  2. Как управлять модальностью пользовательской формы UserForm ? 01.08.2009
  3. Как удалить крестик [X] из строки заголовка UserForm ? 05.08.2007
  4. Как заблокировать крестик [X] и удалить системное меню UserForm ? 19.08.2007
  5. Как в заголовок формы добавить кнопку, позволяющую свернуть окно ? 21.04.2008
  6. Как отобразить UserForm в верхнем правом углу экрана ? 14.06.2010
  7. Как отобразить UserForm поверх всех окон ? 30.11.2014
  8. Как после двойного клика мышки (или клика правой кнопкой) отобразить UserForm, причём с учётом координат ? 15.11.2014
  9. Как программно свернуть пользовательскую форму ? 09.06.2010
  10. Как отловить свёртывание/развёртывание окна, а также определить его состояние ? 28.07.2009
  11. Как удалить заголовок пользовательской формы - UserForm ? 17.08.2007
  12. Как программно узнать высоту заголовка окна ? 20.10.2010
  13. Как сделать так, чтобы размеры диалогового окна можно было изменять с помощью мышки ? 23.07.2009
  14. Как сделать мигающий заголовок пользовательской формы ? 25.01.2009
  15. Как постепенно вывести текст в заголовке пользовательской формы ? 06.07.2008
  16. Как запретить перемещение UserForm с помощью заголовка ? 22.03.2012
  17. Как таскать форму не за заголовок, а за любое место ? 03.06.2011
  18. Как определить handle главного окна приложения Excel ? 12.01.2012
  19. Как создать иконку для формы UserForm и приложения Excel ? 23.09.2007
  20. Как определить количество иконок, содержащихся в файле ? 01.09.2009
  21. Как изменять прозрачность (видимость) формы UserForm и приложения Excel ? 21.06.2014
  22. Как закрыть пользовательскую форму с анимационным эффектом ? 02.09.2007
  23. Как создать строку состояния на диалоговом окне UserForm ? 17.09.2007
  24. Как постепенно отобразить/скрыть элемент управления ? 25.01.2009
  25. Как скрыть/отобразить панель задач Windows ? 12.08.2007
  26. Как отобразить немодальный MsgBox ? 20.10.2007
  27. Как заблокировать вывод на экран стандартного диалогового окна "Печать" (WinAPI) ? 23.12.2007
    [0] [1] [2] [3]


  • Ответ : Скачать пример

    Для того, чтобы в MS Excel 97 отобразить пользовательскую форму в немодальном режиме, получив при этом, возможность работы с ячейками рабочего листа и т.д. можно воспользоваться следующим вариантом :
  • Private Declare Function FindWindow _
            Lib "user32.dll" Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long
    Private Declare Function ShowWindow _
            Lib "user32.dll" ( _
            ByVal hWnd As Long, _
            ByVal nCmdShow As Long) As Long

    Private Sub UserFormModeless97()
        iCaption$ = UserForm1.Caption

        If iCaption$ <> "" Then
           ShowWindow FindWindow(vbNullString, iCaption$), 5&
        Else
           MsgBox "Проверьте наличие заголовка окна", vbInformation, ""
        End If
    End Sub
    В последующих версиях форму можно отображать как в модальном, так и немодальном режиме, причём без использования функций WinAPI. Более подробную информацию можно получить здесь.
  • Ответ : Скачать пример

    Для того, чтобы "управлять" модальностью пользовательской формы, т.е. в зависимости от ситуации "переключаться" с одного режима на другой, достаточно скопировать нижеприведённый код в модуль нужной формы и стандартный модуль.

    UserForm1 :
  • Private Sub CommandButton1_Click() 'vbModal
        EnableWindow ihWnd&, 0&
    End Sub

    Private Sub CommandButton2_Click() 'vbModeless
        EnableWindow ihWnd&, 1&
    End Sub

    Private Sub UserForm_Terminate()
        CommandButton2_Click
    End Sub
    Модуль1 :
    Public Declare Function FindWindow _
           Lib "user32.dll" Alias "FindWindowA" ( _
           ByVal lpClassName As String, _
           ByVal lpWindowName As String) As Long
    Public Declare Function ShowWindow _
           Lib "user32.dll" ( _
           ByVal hWnd As Long, _
           ByVal nCmdShow As Long) As Long
    Public Declare Function EnableWindow _
           Lib "user32.dll" ( _
           ByVal hWnd As Long, _
           ByVal fEnable As Long) As Long
    Public Declare Function GetParent _
           Lib "user32.dll" (ByVal hWnd As Long) As Long

    Public ihWnd&

    Public Sub UserFormModeless97()
        ihWnd& = FindWindow(vbNullString, UserForm1.Caption)

        ShowWindow ihWnd&, 5&

        ihWnd& = GetParent(ihWnd&)
    End Sub
    Примечание : В данном примере предполагается наличие двух кнопок, которые используются только для демонстрации.

    Актуально только для MS Excel XP
    В этой, и последующих версиях, вместо WinAPI функции GetParent Вы можете использовать свойство hWnd об'екта Application, кроме того, Вы можете отказаться и от использования функций FindWindow и ShowWindow, см. пример WinAPI_UserFormOptionModal2002
  • Ответ : Скачать пример

    Для того, чтобы убрать кнопку Закрыть, представляющую собой небольшой крестик, расположенный в правом углу заголовка формы, достаточно скопировать весь нижеприведённый код в модуль нужной формы.
  • Private Declare Function FindWindow _
            Lib "user32.dll" Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowLong _
            Lib "user32.dll" Alias "GetWindowLongA" ( _
            ByVal hWnd As Long, _
            ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong _
            Lib "user32.dll" Alias "SetWindowLongA" ( _
            ByVal hWnd As Long, _
            ByVal nIndex As Long, _
            ByVal dwNewLong As Long) As Long

    Private Sub UserForm_Initialize()
        Dim ihWnd As Long, iStyle As Long

        ihWnd = FindWindow(vbNullString, Me.Caption)
        iStyle = GetWindowLong(ihWnd, -16&)
        SetWindowLong ihWnd, -16&, iStyle And Not &H80000
    End Sub

  • Ответ :

    Для того, чтобы удалить контекстное меню, которое появляется после клика правой кнопки мышки , а также заблокировать кнопку Закрыть, представляющую собой небольшой крестик, расположенный в правом углу заголовка формы, достаточно скопировать весь нижеприведённый код в модуль нужной формы.
  • Private Declare Function FindWindow _
            Lib "user32.dll" Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long
    Private Declare Function GetSystemMenu _
            Lib "user32.dll" ( _
            ByVal hWnd As Long, _
            ByVal bRevert As Long) As Long
    Private Declare Function DestroyMenu _
            Lib "user32.dll" ( _
            ByVal hMenu As Long) As Long

    Private Sub UserForm_Initialize()
        Dim ihWnd As Long, ihMenu As Long

        ihWnd = FindWindow(vbNullString, Me.Caption)
        ihMenu = GetSystemMenu(ihWnd, 0&)
        DestroyMenu ihMenu
    End Sub
    Для того, чтобы заблокировать кнопку Закрыть [X] можно ещё использовать WinAPI функцию RemoveMenu (см. пример)
  • Ответ : Скачать пример

    Для того, чтобы добавить на заголовок пользовательской формы кнопку Свернуть, позволяющую сворачивать окно и отображать его на панели задач, достаточно скопировать весь нижеприведённый код в любой стандартный модуль и указать имя нужной формы.
  • Private Declare Function FindWindow _
            Lib "user32.dll" Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long
    Private Declare Function ShowWindow _
            Lib "user32.dll" ( _
            ByVal hWnd As Long, _
            ByVal nCmdShow As Long) As Long
    Private Declare Function GetWindowLong _
            Lib "user32.dll" Alias "GetWindowLongA" ( _
            ByVal hWnd As Long, _
            ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong _
            Lib "user32.dll" Alias "SetWindowLongA" ( _
            ByVal hWnd As Long, _
            ByVal nIndex As Long, _
            ByVal dwNewLong As Long) As Long

    Private Sub UserForm_Show()
        Dim ihWnd As Long, iStyle As Long

        ihWnd = FindWindow(vbNullString, UserForm1.Caption)

        iStyle = GetWindowLong(ihWnd, -16&)
        SetWindowLong ihWnd, -16&, iStyle Or &H20000

        iStyle = GetWindowLong(ihWnd, -20&)
        SetWindowLong ihWnd, -20&, iStyle Or &H40000

        ShowWindow ihWnd, 5&
    End Sub

  • Ответ :

    Если Вы хотите отобразить пользовательскую форму в верхнем правом углу экрана, то для достаточно воспользоваться одним из двух нижеприведённых способов. Только обратите внимание на то, что применение функции WinAPI имеет смысл, если окно приложения, т.е. MS Excel не развёрнуто во весь экран, в противном случае достаточно просто отобразить UserForm в верхнем правом углу приложения [FAQ69]

    Вариант I.
  • Private Declare Function GetSystemMetrics _
            Lib "user32.dll" (ByVal nIndex As Long) As Long

    Private Sub UserForm_Initialize()
        Me.StartUpPosition = 0
        Me.Move GetSystemMetrics(1&) - Me.Width, 0
    End Sub
    Вариант II.
    Private Declare Function GetSystemMetrics _
            Lib "user32.dll" (ByVal nIndex As Long) As Long

    Private Sub UserForm_Initialize()
        Me.StartUpPosition = 0: Me.Top = 0
        Me.Left = GetSystemMetrics(1&) - Me.Width
    End Sub
    Внимание : Значение свойства StartUpPosition можно установить вручную.
  • Ответ :

    Для того, чтобы отобразить пользовательскую форму поверх всех окон, достаточно скопировать нижеопубликованный код в модуль нужной формы.
  • Private Const HWND_TOPMOST = -1
    Private Const SWP_NOSIZE = &H1
    
    Private Declare Function FindWindow _
            Lib "user32.dll" Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long
    Private Declare Function SetWindowPos Lib "user32.dll" ( _
            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 Sub UserForm_Initialize()
        Dim ihWnd&
    
        ihWnd = FindWindow(vbNullString, Me.Caption)
        SetWindowPos ihWnd, HWND_TOPMOST, 0&, 0&, 0&, 0&, SWP_NOSIZE
    End Sub
    

  • Ответ : Скачать пример

    Для того, чтобы после двойного клика мышки, отобразить нужное диалоговое окно, причём с учётом координат, а редактирование ячейки, запретить, достаточно воспользоваться событием листа Worksheet_BeforeDoubleClick
  • Private Const SWP_NOSIZE = &H1
    Private Const SWP_SHOWWINDOW = &H40
    
    Private Type POINTAPI
        X As Long
        Y As Long
    End Type
    
    Private Declare Function GetCursorPos _
            Lib "user32.dll" (lpPoint As POINTAPI) As Long
    Private Declare Function FindWindow _
            Lib "user32.dll" Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long
    Private Declare Function SetWindowPos Lib "user32.dll" ( _
            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 Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
        Dim ihWnd&, iPoint As POINTAPI
    
        GetCursorPos iPoint: Cancel = True
        ihWnd = FindWindow(vbNullString, UserForm1.Caption)
        SetWindowPos ihWnd, 0&, iPoint.X, iPoint.Y, 0&, 0&, SWP_NOSIZE Or SWP_SHOWWINDOW
    End Sub
    Комментарий :
  • Обратите внимание на то, что UserForm будет отображаться в немодальном режиме. Если это неприемлемо, то используйте функцию WinAPI SetWindowPos только для перемещения окна (смотрите пример)
  • Если Вы не хотите лицезреть текст в заголовке формы, то не удаляйте его полностью, а замените на один(или несколько) пробелов
  • Запрет на переход в режим редактирования (Cancel = True) не является обязательным условием
  • Если вместо двойного клика, Вам необходимо будет отображать форму, после клика правой кнопки мышки, то используйте событие Worksheet_BeforeRightClick (смотрите пример)
  • Ответ : Скачать пример

    Если Вы, используя предыдущий совет, добавили на заголовок своей пользовательской формы кнопку Свернуть, но теперь возникла необходимость сворачивать окно ещё и программно, то осуществить это можно, как минимум, двумя способами :

    Вариант I.
  • Private Declare Function FindWindow _
            Lib "user32.dll" Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long
    Private Declare Function ShowWindow _
            Lib "user32.dll" ( _
            ByVal hWnd As Long, _
            ByVal nCmdShow As Long) As Long

    Private Sub CommandButton1_Click()
        ShowWindow FindWindow(vbNullString, Me.Caption), 6& '2&
    End Sub
    Вариант II.
    Private Declare Function FindWindow _
            Lib "user32.dll" Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long
    Public Declare Function CloseWindow _
            Lib "user32.dll" ( _
            ByVal hWnd As Long) As Long

    Private Sub CommandButton1_Click()
        CloseWindow FindWindow(vbNullString, Me.Caption)
    End Sub

  • Ответ : Скачать пример

    Если Вы, используя предыдущий совет, добавили на заголовок своей пользовательской формы кнопку Свернуть и теперь у Вас возникла необходимость отловить момент свёртывания/развёртывания формы, то осуществить это можно использовав событие формы UserForm_Resize(), а определить "состояние" окна, можно с помощью WinAPI функции IsIconic (см. пример)
  • Ответ : Скачать пример

    Для того, чтобы убрать заголовок формы, достаточно скопировать весь нижеприведённый код в модуль нужной формы.
  • Private Declare Function FindWindow _
            Lib "user32.dll" Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowLong _
            Lib "user32.dll" Alias "GetWindowLongA" ( _
            ByVal hWnd As Long, _
            ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong _
            Lib "user32.dll" Alias "SetWindowLongA" ( _
            ByVal hWnd As Long, _
            ByVal nIndex As Long, _
            ByVal dwNewLong As Long) As Long
    Private Declare Function DrawMenuBar Lib "user32.dll" ( _
            ByVal hWnd As Long) As Long

    Private Sub UserForm_Initialize()
        Dim ihWnd As Long, iStyle As Long

        ihWnd = FindWindow(vbNullString, Me.Caption)
        iStyle = GetWindowLong(ihWnd, -16&)
        SetWindowLong ihWnd, -16&, iStyle And Not &HC00000
        DrawMenuBar ihWnd
    End Sub

  • Ответ :

    Для того, чтобы определить высоту заголовка окна, в т.ч. и UserForm, можно использовать, например, WinAPI функцию GetSystemMetrics
  • Private Declare Function GetSystemMetrics _
            Lib "user32.dll" ( _
            ByVal nIndex As Long) As Long

    Private Sub TitleBarInfo_Height()
        iTitleBarHeight& = GetSystemMetrics(4&)
    End Sub

  • Ответ :

    Для того, чтобы Вы могли изменять размеры пользовательской формы, достаточно скопировать весь нижеприведённый код в модуль нужной формы, и в дальнейшем просто использовать мышку.
  • Private Declare Function FindWindow _
            Lib "user32.dll" Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowLong _
            Lib "user32.dll" Alias "GetWindowLongA" ( _
            ByVal hWnd As Long, _
            ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong _
            Lib "user32.dll" Alias "SetWindowLongA" ( _
            ByVal hWnd As Long, _
            ByVal nIndex As Long, _
            ByVal dwNewLong As Long) As Long
    
    Private Sub UserForm_Initialize()
        Dim ihWnd As Long, iStyle As Long
    
        ihWnd = FindWindow(vbNullString, Me.Caption)
        iStyle = GetWindowLong(ihWnd, -16&)
        SetWindowLong ihWnd, -16&, iStyle Or &H40000
    End Sub

  • Ответ : Скачать пример

    Для того, сделать так, чтобы заголовок пользовательской формы мигал нужное количество раз, достаточно всего лишь использовать нижеприведённую процедуру FlashChangeWindow() (изменив имя формы, количество бликов и интервал между ними, на необходимые)
  • Private Declare Function FindWindow Lib "user32.dll" _
            Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long
    Private Declare Function FlashWindow Lib "user32.dll" ( _
            ByVal hWnd As Long, _
            ByVal bInvert As Long) As Long
    Private Declare Sub Sleep Lib "kernel32.dll" ( _
            ByVal dwMilliseconds As Long)
    
    Private Sub FlashChangeWindow()
        Dim ihWnd As Long, iCount As Integer
        ihWnd = FindWindow(vbNullString, UserForm1.Caption) 'Me.Caption
        For iCount = 1 To 20
            FlashWindow ihWnd, 1&: Sleep 250&
        Next
    End Sub

  • Ответ : Скачать пример

    Для того, чтобы в заголовке пользовательской формы текст появлялся постепенно, достаточно скопировать весь нижеприведённый код в модуль нужной формы.
  • Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

    Private Sub UserForm_Activate()
        iCaption$ = "Текст, который должен появиться в заголовке"
        DoEvents 'Me.Repaint
        For iCount& = 1 To Len(iCaption$)
            Me.Caption = Left(iCaption$, iCount&) 'Mid(iCaption$, 1, iCount&)
            Sleep 250&
        Next
    End Sub

  • Ответ :

    Для того, чтобы запретить перемещение пользовательской формы с помощью заголовка, его можно просто убрать [FAQ345] , однако, если его наличие необходимо, то можно удалить соответствующую команду из системного меню. В качестве бонуса, присутствует также удаление разделителя (сепаратора) команд.
  • Private Declare Function FindWindow _
            Lib "user32.dll" Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long
    Private Declare Function GetSystemMenu _
            Lib "user32.dll" ( _
            ByVal hWnd As Long, _
            ByVal bRevert As Long) As Long
    Private Declare Function DeleteMenu _
            Lib "user32.dll" ( _
            ByVal hMenu As Long, _
            ByVal nPosition As Long, _
            ByVal wFlags As Long) As Long
    'Private Declare Function RemoveMenu _
            Lib "user32.dll" ( _
            ByVal hMenu As Long, _
            ByVal nPosition As Long, _
            ByVal wFlags As Long) As Long
    Private Declare Function DrawMenuBar Lib "user32.dll" ( _
            ByVal hWnd As Long) As Long

    Private Sub UserForm_Initialize()
        Dim ihWnd As Long, ihMenu As Long

        ihWnd = FindWindow(vbNullString, Me.Caption)
        ihMenu = GetSystemMenu(ihWnd, 0&)

        DeleteMenu ihMenu, 61456&, 0&
        DeleteMenu ihMenu, 0&, 2048&
        DrawMenuBar ihWnd
    End Sub

  • Ответ :
  • Dim ihWnd As Long

    Const WM_NCLBUTTONDOWN = &HA1
    Const HTCAPTION = 2

    Private Declare Function FindWindow _
            Lib "user32" Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long
    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 Declare Function ReleaseCapture _
            Lib "user32" () As Long

    Private Sub UserForm_Initialize()
        ihWnd = FindWindow(vbNullString, Me.Caption)
    End Sub

    Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        Call ReleaseCapture
        Call SendMessage(ihWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End Sub
    Источник : Sources.ru | FAQ
  • Ответ :

    Для того, чтобы определить дескриптор окна Excel, можно использовать :

    Вариант I. WinAPI функцию FindWindow , которая имеет два аргумента : первый, это имя класса, в нашем случае "XLMAIN" (регистр не важен), а второй, это имя окна, т.е. текст в строке заголовка (если таковой неизвестен, то допускается использование vbNullString)
  • Private Declare Function FindWindow _
            Lib "user32" Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long

    Private Sub ExcelWindowHandle()
        Dim ihWnd As Long
        ihWnd = FindWindow("XLMAIN", Application.Caption)
    End Sub
    Вариант II. Актуально только для MS Excel 97

    Если при инсталяции Microsoft Excel 97 Вы установили надстройку Мастер Web-страниц (HTML.XLA), а стало быть и файл xlhtml.dll, то :
    Private Declare Function GetExcelWindowHandle Lib "xlhtml.dll" () As Long

    Private Sub ExcelWindowHandle()
        Dim ihWnd As Long
        ihWnd = GetExcelWindowHandle
    End Sub
    Примечание : Если в указанной версии возникли проблемы, связанные с отсутствием файла xlhtml.dll, то рекомендую ознакомиться со следующей статьей, которая опубликована на официальном сайте Microsoft

    XL97: Internet Assistant Update Does Not Include XLHTML.DLL

    Вариант III. Актуально только для MS Excel XP

    В Microsoft Excel XP (и последущих) версиях, при решении поставленной задачи, вполне можно обойтись и без явного применения WinAPI функций, ибо у об'екта Application появилось свойство hWnd
    ihWnd = Application.hWnd

  • Ответ : Скачать пример

    Для того, чтобы после отображения UserForm, в заголовке формы присутствовала иконка, можно скопировать весь нижеприведённый код в модуль нужной формы, указав, при этом, свой файл с иконкой. Обратите внимание на то, что иконку могут содержать не только файлы с расширением .ico, но ещё и .exe, .dll
  • Private Declare Function FindWindow _
            Lib "user32.dll" Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long
    Private Declare Function ExtractIcon _
            Lib "shell32.dll" Alias "ExtractIconA" ( _
            ByVal hInst As Long, _
            ByVal lpszExeFileName As String, _
            ByVal nIconIndex As Long) As Long
    Private Declare Function SetClassLong _
            Lib "user32.dll" Alias "SetClassLongA" ( _
            ByVal hWnd As Long, _
            ByVal nIndex As Long, _
            ByVal dwNewLong As Long) As Long
    Private Declare Function DestroyIcon _
            Lib "user32.dll" ( _
            ByVal hIcon As Long) As Long
    'Private Declare Function DrawMenuBar Lib "user32.dll" ( _
    '        ByVal hWnd As Long) As Long

    Private Sub UserForm_Initialize()
        Dim iFile As String
        Dim ihWnd As Long, ihIcon As Long

        iFile = "C:\WINDOWS\WINUPD.ICO" 'Укажите свой файл
        ihWnd = FindWindow(vbNullString, Me.Caption)
        ihIcon = ExtractIcon(0&, iFile, 0&)

        SetClassLong ihWnd, -14&, ihIcon
        DestroyIcon ihIcon: 'DrawMenuBar ihWnd
    End Sub
    Изменение иконки в строке заголовка окна приложения, ничем принципиально не отличается, т.е.
    Private Sub Application_ChangeIcon()
        Dim iFile As String
        Dim ihWnd As Long, ihIcon As Long

        iFile = "C:\WINDOWS\WINUPD.ICO" 'Укажите свой файл
        ihWnd = FindWindow("XLMAIN", Application.Caption)
        ihIcon = ExtractIcon(0&, iFile, 0&)

        SetClassLong ihWnd, -14&, ihIcon
        DestroyIcon ihIcon
    End Sub

  • Ответ : Скачать пример

    Для того, чтобы определить количество иконок, содержащихся в файле, можно также использовать WinAPI функцию ExtractIcon. Обратите внимание на то, что иконки могут содержать не только файлы с расширением .exe, но и .dll, а также .ico (правда эти файлы содержат всего одну иконку)
  • Private Declare Function ExtractIcon _
            Lib "shell32.dll" Alias "ExtractIconA" ( _
            ByVal hInst As Long, _
            ByVal lpszExeFileName As String, _
            ByVal nIconIndex As Long) As Long

    Private Sub UserForm_Initialize()
        Dim iFile As String, iIconCount As Long

        iFile = "C:\WINDOWS\EXPLORER.EXE" 'Укажите свой файл
        iIconCount = ExtractIcon(0&, iFile, -1&)

        If iIconCount = 0 Then
           MsgBox "Указанный файл не содержит иконок", , ""
        Else
           MsgBox "Количество иконок : " & iIconCount, , ""
        End If
    End Sub
    Пример, позволяющий не только определить количество, но и осуществить просмотр всех иконок можно скачать здесь ...
  • Ответ :

    Для того, чтобы при изменять прозрачность(видимость) формы и всех её контролов, можно использовать нижеопубликованный вариант, где прозрачность управляется с помощью параметра bAlpha, т.е.

  • 0 - окно полностью прозрачно (невидимо)
  • 255 - непрозрачно (видимо)
  • Private Declare Function FindWindow _
            Lib "user32.dll" Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowLong _
            Lib "user32.dll" Alias "GetWindowLongA" ( _
            ByVal hWnd As Long, _
            ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong _
            Lib "user32.dll" Alias "SetWindowLongA" ( _
            ByVal hWnd As Long, _
            ByVal nIndex As Long, _
            ByVal dwNewLong As Long) As Long
    Private Declare Function SetLayeredWindowAttributes _
            Lib "user32.dll" ( _
            ByVal hWnd As Long, _
            ByVal crKey As Long, _
            ByVal bAlpha As Long, _
            ByVal dwFlags As Long) As Long

    Private Sub UserForm_Initialize()
        Dim ihWnd As Long, iStyle As Long

        ihWnd = FindWindow(vbNullString, Me.Caption)
        iStyle = GetWindowLong(ihWnd, -20&)
        SetWindowLong ihWnd, -20&, iStyle Or 524288&
        SetLayeredWindowAttributes ihWnd, 0&, 100&, 2&
    End Sub
    Комментарий : Аналогичным образом можно изменять прозрачность и других окон, в т.ч. числе и самого Excel, только необходимо указать его handle. Более подробную информацию о его получении можно найти [FAQ648]

    Примечание : Минимальные требования, при использовании данной функции, наличие Windows 2000
  • Ответ :

    Для того, чтобы при закрытии, форма исчезла с экрана не сразу, а с некоторым анимационным эффектом, достаточно скопировать весь нижеприведённый код в модуль нужной формы.
  • 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.dll" ( _
            ByVal hWnd As Long, _
            ByVal dwTime As Long, _
            ByVal dwFlags As Long) As Long

    Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
        ihWnd& = FindWindow(vbNullString, Me.Caption)
        AnimateWindow ihWnd&, 500&, &H10000 Or &H10
    End Sub

    Private Sub CommandButton1_Click()
        Unload Me
    End Sub
    ФлагЭффект
    &H10 окно сужается в центр
    &H1окно исчезает слево направо
    &H2окно исчезает справо налево
    &H4окно исчезает сверху вниз
    &H8окно исчезает снизу вверх

    Примечание : Необходимо наличие Windows 98, Windows Me
  • Ответ : Скачать пример

    Для того, чтобы создать строку состояния можно воспользоваться одним из двух вариантов [FAQ373], но если эти способы Вам не подходят, то можно использовать и функции WinAPI.
  • Private Declare Function CreateStatusWindow _
            Lib "comctl32.dll" Alias "CreateStatusWindowA" ( _
            ByVal Style As Long, _
            ByVal pszText As String, _
            ByVal hWndParent As Long, _
            ByVal wID 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 SetWindowText _
            Lib "user32.dll" Alias "SetWindowTextA" ( _
            ByVal hWnd As Long, _
            ByVal lpString As String) As Long
    Private Declare Function DestroyWindow _
            Lib "user32.dll" ( _
            ByVal hWnd As Long) As Long

    Private ihWndStatusBar&

    Private Sub UserForm_Initialize()
        Dim ihWnd&, iStyle&

        ihWnd = FindWindow(vbNullString, Me.Caption)
        iStyle = &H40000000 Or &H10000000

        ihWndStatusBar = CreateStatusWindow(iStyle, "Строка состояния", ihWnd, 0&)
    End Sub

    Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        SetWindowText ihWndStatusBar, "X:" & X & " ; Y:" & Y
        'изменение текста, при перемещении мышки,
        'используется исключительно в демонстрационных целях
        'и может быть осуществленно ещё и с помощью функции SendMessage
    End Sub

    Private Sub UserForm_Terminate()
        DestroyWindow ihWndStatusBar
    End Sub

    Private Sub CommandButton1_Click()
        Unload Me
    End Sub

  • Ответ : Скачать пример

    Небольшой пример того, как можно постепенно отобразить/скрыть нужный/ненужный элемент управления, можно скачать здесь.
  • Ответ :

    Для того, чтобы скрыть панель задач достаточно выполнить макрос HiddenTaskBar(), а за отображение панели задач отвечает макрос VisibleTaskBar()

    Вариант I.
  • Private Declare Function FindWindow _
            Lib "user32.dll" Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long
    Private Declare Function ShowWindow _
            Lib "user32.dll" ( _
            ByVal hWnd As Long, _
            ByVal nCmdShow As Long) As Long

    Private Sub HiddenTaskBar()
        ShowWindow FindWindow("Shell_TrayWnd", vbNullString), 0&
    End Sub

    Private Sub VisibleTaskBar()
        ShowWindow FindWindow("Shell_TrayWnd", vbNullString), 4& '1&
    End Sub
    Вариант II.
    Private Declare Function FindWindow _
            Lib "user32.dll" Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long
    Private Declare Function SetWindowPos _
            Lib "user32.dll" ( _
            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 Sub HiddenTaskBar()
        ihWnd& = FindWindow("Shell_TrayWnd", vbNullString)
        SetWindowPos ihWnd&, 0&, 0&, 0&, 0&, 0&, 128&
    End Sub

    Private Sub VisibleTaskBar()
        ihWnd& = FindWindow("Shell_TrayWnd", vbNullString)
        SetWindowPos ihWnd&, 0&, 0&, 0&, 0&, 0&, 64&
    End Sub

  • Ответ :

    Для того, чтобы отобразить немодальный MsgBox, можно, используя UserForm, создать имитацию этого диалогового окна и отобразить созданную форму в немодальном режиме (MS Excel 2000) Однако, если этот способ, по каким-то причинам Вас не устраивает, то поставленную задачу можно решить и с помощью WinAPI функции MessageBox
  • Private Declare Function MessageBox _
            Lib "user32.dll" Alias "MessageBoxA" ( _
            ByVal hWnd As Long, _
            ByVal lpText As String, _
            ByVal lpCaption As String, _
            ByVal wType As Long) As Long

    Private Sub MsgBox_Modeless()
        MessageBox 0&, "Текст сообщения", "Текст заголовка", 0&
    End Sub

  • Ответ :

    Для того, чтобы при печати, на экране не появлялось стандартное диалоговое окно, можно временно заблокировать обновление окна, с помощью WinAPI функции LockWindowUpdate
  • Private Declare Function GetDesktopWindow _
            Lib "user32.dll" () As Long
    Private Declare Function LockWindowUpdate _
            Lib "user32.dll" (ByVal hWnd As Long) As Long

    Private Sub WinAPI_EnableDialogPrint()
        LockWindowUpdate GetDesktopWindow
       
        'Здесь Вы можете вывести на печать необходимую информацию, например
        ThisWorkbook.Worksheets(1).PrintOut
       
        LockWindowUpdate 0&
    End Sub

    Воспроизведение любых опубликованных здесь материалов возможно только с письменного разрешения автора : Microsoft Excel 95, 97, 2000, XP

    © 2004-2016 Климов П.Ю. Все права защищены. WebDesign & Error's Klimoff