1 ''' // ******************************************************************
   2 ''' // Tools Collection for various tasks
   3 ''' // (c)digital-ecom 2009
   4 ''' // ******************************************************************
   5 
   6 Option Explicit
   7 Option Private Module
   8 
   9 ''' // Windows API calls for Max- and Minimize Btns
  10 Private Declare Function FindWindowA Lib "user32" _
  11                                         (ByVal lpClassName As String, _
  12                                         ByVal lpWindowName As String) As Long
  13 
  14 Private Declare Function GetWindowLongA Lib "user32" _
  15                                         (ByVal hwnd As Long, _
  16                                         ByVal nIndex As Long) As Long
  17 
  18 Private Declare Function SetWindowLongA Lib "user32" _
  19                                         (ByVal hwnd As Long, _
  20                                         ByVal nIndex As Long, _
  21                                         ByVal dwNewLong As Long) As Long
  22 
  23 Private Declare Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" _
  24                                         (ByVal hwnd As Long, _
  25                                         ByVal nIndex As Long, _
  26                                         ByVal dwNewLong As Long) As Long
  27 
  28 
  29  Const GWL_STYLE As Long = -16
  30  Const WS_MAXIMIZEBOX As Long = &H10000
  31  Const WS_MINIMIZEBOX As Long = &H20000
  32 
  33 ' //////////////////////////////////////////////////////////////
  34 ''' // GET LAST ROW
  35 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  36 ''' // This gets the last row filled with data. The fct requires you to handover a specific worksheet before you obtain the last row.
  37 ''' // The fct. remembers the currently active window and activates it again after its job is done. This is required in case the
  38 ''' // worksheet to lookup last row or column is hidden. Otherwise, screen would not be updated anymore.
  39 Function Get_Last_Row(WS As Worksheet) As Long
  40 Dim activeWS As Worksheet
  41     Set activeWS = ActiveSheet
  42 
  43     WS.Activate
  44     On Error Resume Next
  45        Get_Last_Row = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
  46 
  47     If Err.Number = 91 Then
  48         Get_Last_Row = 1
  49         Else
  50     End If
  51     On Error GoTo 0
  52     activeWS.Activate
  53 End Function
  54 
  55 ' //////////////////////////////////////////////////////////////
  56 ''' // GET LAST COLUMN
  57 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  58 ''' // This gets the last column filled with data. The fct requires you to handover a specific worksheet before you obtain the last row.
  59 ''' // The fct. remembers the currently active window and activates it again after its job is done. This is required in case the
  60 ''' // worksheet to lookup last row or column is hidden. Otherwise, screen would not be updated anymore.
  61 Function Get_Last_Column(WS As Worksheet) As Long
  62 Dim activeWS As Worksheet
  63     Set activeWS = ActiveSheet
  64 
  65     WS.Activate
  66     On Error Resume Next
  67         Get_Last_Column = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
  68 
  69     If Err.Number = 91 Then
  70         Get_Last_Column = 1
  71         Else
  72     End If
  73     On Error GoTo 0
  74     activeWS.Activate
  75 End Function
  76 
  77 
  78 ' //////////////////////////////////////////////////////////////
  79 ''' // BLOW USERFORM TO (NEARLY) MAXIMUM SIZE
  80 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  81 ''' // Resize a Dlg by doubleclick to its maximized size, depending on application window size
  82 ''' // Ver.: 1.0.0; 16.07.2009; UG
  83 ''' // Expects the Dlg as object; normally triggered by doubleclick on resize icon at lower right hand side.
  84 ''' // Will immediately maximize display of Dlg and fit it into appl. window.
  85 ''' // Note: This fct. gives space to the maximized window, allowing to see the status bar of MS Excel - this is benefitial in case
  86 ''' //          you display progress indicators there. Using the Maximize Btn. instead, will hide the status bar.
  87 Function BlowDlg_FullSize(obj As Object)
  88 Dim t As Double
  89 Dim l As Double
  90 
  91     On Error GoTo WindowIsMax
  92 
  93     t = Application.Top
  94     l = Application.Left
  95 
  96     obj.Width = BlowDlg_MaxWidth
  97     obj.Height = BlowDlg_MaxHeight
  98     obj.Top = t + 40
  99     obj.Left = l + 10
 100     Exit Function
 101 WindowIsMax:
 102 End Function
 103 
 104 Function BlowDlg_MaxWidth() As Double
 105     BlowDlg_MaxWidth = Application.Width - 20
 106 End Function
 107 
 108 Function BlowDlg_MaxHeight() As Double
 109     BlowDlg_MaxHeight = Application.Height - 50
 110 End Function
 111 
 112 
 113 ' //////////////////////////////////////////////////////////////
 114 ' Windows API based functions
 115 ' //////////////////////////////////////////////////////////////
 116 
 117 ''' // *********************************************************************************
 118 ''' // Windows Handling - Resize, MenuBar, etc.
 119 ''' // *********************************************************************************
 120 ''' // Add Maximize Btn to a VBA UserForm.
 121 ''' // Note: This will add minimize and maximize button always - there is no way for just adding one of them.
 122 ''' //          Anyhow, you do not have to activate the buttons.
 123 Sub UserForm_AddMaximizeBtn(UserFormCaption As String)
 124 Dim hwnd As Long
 125 Dim exLong As Long
 126 
 127     hwnd = FindWindowA(vbNullString, UserFormCaption)
 128     exLong = GetWindowLongA(hwnd, -16)
 129     If (exLong And WS_MAXIMIZEBOX) = 0 Then
 130         SetWindowLongPtr hwnd, GWL_STYLE, exLong Or WS_MAXIMIZEBOX ''' // Adds both Btns but activates Max Btn, only.
 131         'SetWindowLongPtr hWnd, GWL_STYLE, exLong OR WS_MINIMIZEBOX ''' // Uncomment, in order to activate Minimize Btn, too.
 132     Else
 133     End If
 134 End Sub
 135 
 136