[推荐]为VBA窗体添加最大化,最小化,图标

'/                                     /'
'///////////////////////////////////////'
'
'Written: Jan. 30, 2007
'Author: Leith Ross'Returns an Icon from a File (.ico)
 Private Declare Function LoadImage _
  Lib "user32.dll" _
   Alias "LoadImageA" _
    (ByVal hInst As Long, _
     ByVal lpsz As String, _
     ByVal uType As Long, _
     ByVal cxDesired As Long, _
     ByVal cyDesired As Long, _
     ByVal fuLoad As Long) As Long'Direct System what to do with the Window
 Private Declare Function SendMessage _
  Lib "user32.dll" _
   Alias "SendMessageA" _
    (ByVal hWnd As Long, _
     ByVal wMsg As Long, _
     ByVal wParam As Long, _
     lParam As Long) As Long'Constants for SendMessage
 Const WM_GETICON As Long = &H7F
 Const WM_SETICON As Long = &H80
 Const ICON_SMALL As Long = &H0
 Const ICON_BIG As Long = &H1'Constants for Load Image's fuLoad Parameter (Load Resource)
 Const LR_DEFAULTCOLOR As Long = &H0
 Const LR_MONOCHROME As Long = &H1
 Const LR_COLOR As Long = &H2
 Const LR_COPYRETURNORG As Long = &H4
 Const LR_COPYDELETEORG As Long = &H8
 Const LR_LOADFROMFILE As Long = &H10
 Const LR_LOADTRANSPARENT As Long = &H20
 Const LR_DEFAULTSIZE As Long = &H40
 Const LR_VGACOLOR As Long = &H80
 Const LR_LOADMAP3DCOLORS As Long = &H1000
 Const LR_CREATEDIBSECTION As Long = &H2000
 Const LR_COPYFROMRESOURCE As Long = &H4000
 Const LR_SHARED As Long = &H8000'Constants for Load Image's uType Parameter
 Const IMAGE_BITMAP As Long = &H0
 Const IMAGE_ICON As Long = &H1
 Const IMAGE_CURSOR As Long = &H2'Constants for ShowWindow (nCmdShow)
 Const SW_HIDDEN As Long = 0
 Const SW_NORMAL As Long = 1
 Const SW_MINIMIZED As Long = 2
 Const SW_MAXIMIZED As Long = 3
 Const SW_NOTACTIVE As Long = 4
 Const SW_UNHIDDEN As Long = 5
 Const SW_MINWITHFOCUS As Long = 6
 Const SW_MINNOTACTIVE As Long = 7
 Const SW_RESTORE As Long = 9'Constants for GetWindow
 Const GW_HWNDFIRST As Long = &H0
 Const GW_HWNDLAST As Long = &H1
 Const GW_HWNDNEXT As Long = &H2
 Const GW_HWNDPREV As Long = &H3
 Const GW_OWNER As Long = &H4
 Const GW_CHILD As Long = &H5'Window Style constants
 Const WS_DISABLE As Long = 0
 Const WS_MAXIMIZEBOX As Long = &H10000
 Const WS_MINIMIZEBOX As Long = &H20000
 Const WS_THICKFRAME As Long = &H40000    'Style to add a sizable frame
 Const WS_SYSMENU As Long = &H80000
 Const WS_ENABLE As Long = &HFFFFFFFF
 
'Get Window Long constants
 Const GWL_HINSTANCE As Long = (-6)
 Const GWL_HWNDPARENT As Long = (-8)
 Const GWL_ID As Long = (-12)
 Const GWL_STYLE As Long = (-16)
 Const GWL_EXSTYLE As Long = (-20)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'Function to Change how Window is Displayed
 Private Declare Function ShowWindow _
  Lib "user32.dll" _
   (ByVal hWnd As Long, _
    ByVal nCmdShow As Long) As Long'Returns the Window Handle of the Active Window
 Private Declare Function GetActiveWindow _
  Lib "user32.dll" () As Long'Redraw the Icons on the Window's Title Bar
 Private Declare Function DrawMenuBar _
  Lib "user32.dll" _
   (ByVal hWnd As Long) As LongPublic Sub MinimizeWindow(Optional ByVal Window_Handle As Long, Optional ByVal With_Focus As Boolean)
  
 Dim RetVal
 
  If With_Focus = True Then
    RetVal = ShowWindow(Window_Handle, SW_MINWITHFOCUS)
  Else
    RetVal = ShowWindow(Window_Handle, SW_MINNOTACTIVE)
  End If
  
End SubPublic Sub RestoreWindow(Optional ByVal Window_Handle As Long)
 
 Dim RetVal
  
  RetVal = ShowWindow(Window_Handle, SW_NORMAL)End Sub
Public Sub AddMinBox(Optional Window_Handle As Long) Dim hWnd As Long
 Dim BitMask As Long
 Dim WindowStyle As Long   If Window_Handle = 0 Then
      hWnd = GetActiveWindow()
   Else
      hWnd = Window_Handle
   End If
  
   WindowStyle = GetWindowLong(hWnd, GWL_STYLE)
   BitMask = WindowStyle Or WS_MINIMIZEBOX
  
   Call SetWindowLong(hWnd, GWL_STYLE, BitMask)
   Call DrawMenuBar(hWnd)End SubPublic Sub AddMaxBox(Optional Window_Handle As Long) Dim hWnd As Long
 Dim BitMask As Long
 Dim WindowStyle As Long   If Window_Handle = 0 Then
      hWnd = GetActiveWindow()
   Else
      hWnd = Window_Handle
   End If
  
   WindowStyle = GetWindowLong(hWnd, GWL_STYLE)
   BitMask = WindowStyle Or WS_MAXIMIZEBOX   Call SetWindowLong(hWnd, GWL_STYLE, BitMask)
   Call DrawMenuBar(hWnd)End Sub
     
Public Function ChangeIcon(ByVal Icon_File_Path As String, Optional ByVal Window_Handle As Long)  Dim hWnd As Long
  Dim hIcon As Long
  Dim LoadMask As Long    If Window_Handle = 0 Then
       hWnd = GetActiveWindow()
    Else
       hWnd = Window_Handle
    End If
    
     LoadMask = LR_LOADFROMFILE Or LR_DEFAULTSIZE Or LR_SHARED
     hIcon = LoadImage(0&, Icon_File_Path, IMAGE_ICON, 32, 32, LoadMask)     Call SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)
     Call DrawMenuBar(hWnd)End Function
Private Sub UserForm_Activate()    AddMinBox
    AddMaxBox
    ChangeIcon "C:\ndpsetup.ico"    '图标路径
    
End Sub