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 Function Get_Last_Row(WS As Worksheet) As Long 38 Dim activeWS As Worksheet 39 Set activeWS = ActiveSheet 40 41 WS.Activate 42 On Error Resume Next 43 Get_Last_Row = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row 44 45 If Err.Number = 91 Then 46 Get_Last_Row = 1 47 Else 48 End If 49 On Error GoTo 0 50 activeWS.Activate 51 End Function 52 53 ' ////////////////////////////////////////////////////////////// 54 ''' // GET LAST COLUMN 55 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 56 ''' // This gets the last column filled with data. The fct requires you to handover a specific worksheet before you obtain the last row. 57 Function Get_Last_Column(WS As Worksheet) As Long 58 Dim activeWS As Worksheet 59 Set activeWS = ActiveSheet 60 61 WS.Activate 62 On Error Resume Next 63 Get_Last_Column = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column 64 65 If Err.Number = 91 Then 66 Get_Last_Column = 1 67 Else 68 End If 69 On Error GoTo 0 70 activeWS.Activate 71 End Function 72 73 ' ////////////////////////////////////////////////////////////// 74 ' Windows API based functions 75 ' ////////////////////////////////////////////////////////////// 76 77 ''' // ********************************************************************************* 78 ''' // Windows Handling - Resize, MenuBar, etc. 79 ''' // ********************************************************************************* 80 ''' // Add Maximize Btn to a VBA UserForm. 81 ''' // Note: This will add minimize and maximize button always - there is no way for just adding one of them. 82 ''' // Anyhow, you do not have to activate the buttons. 83 Sub UserForm_AddMaximizeBtn(UserFormCaption As String) 84 Dim hwnd As Long 85 Dim exLong As Long 86 87 hwnd = FindWindowA(vbNullString, UserFormCaption) 88 exLong = GetWindowLongA(hwnd, -16) 89 If (exLong And WS_MAXIMIZEBOX) = 0 Then 90 SetWindowLongPtr hwnd, GWL_STYLE, exLong Or WS_MAXIMIZEBOX ''' // Adds both Btns but activates Max Btn, only. 91 'SetWindowLongPtr hWnd, GWL_STYLE, exLong OR WS_MINIMIZEBOX ''' // Uncomment, in order to activate Minimize Btn, too. 92 Else 93 End If 94 End Sub 95 96