From 147dac8dbfc26599f3c19554f98041db903a4f88 Mon Sep 17 00:00:00 2001 From: Martin Leduc <31558169+DecimalTurn@users.noreply.github.com> Date: Wed, 20 Dec 2023 14:34:28 -0500 Subject: [PATCH] Fix line endings --- Assembler.bas | 1064 ++++++++--------- src/Pomodoro_Timer.xlsb/API_AlwaysOnTop.bas | 124 +- src/Pomodoro_Timer.xlsb/API_Maximize.bas | 64 +- src/Pomodoro_Timer.xlsb/API_Pixel.bas | 140 +-- src/Pomodoro_Timer.xlsb/API_Sleep.bas | 42 +- src/Pomodoro_Timer.xlsb/API_WorkArea.bas | 86 +- src/Pomodoro_Timer.xlsb/CountDown_mac.bas | 410 +++---- src/Pomodoro_Timer.xlsb/Main.bas | 84 +- src/Pomodoro_Timer.xlsb/OpenItself.bas | 370 +++--- src/Pomodoro_Timer.xlsb/PomodoroTimer.frm | 596 ++++----- src/Pomodoro_Timer.xlsb/Records.bas | 220 ++-- .../ThisWorkbook.sheet.cls | 60 +- src/Pomodoro_Timer.xlsb/UDF_ExcelIntances.bas | 104 +- src/Pomodoro_Timer.xlsb/UDF_LastCell.bas | 44 +- src/Pomodoro_Timer.xlsb/UDF_RGB.bas | 38 +- src/Pomodoro_Timer.xlsb/VBA_Optimize.bas | 32 +- src/Pomodoro_Timer.xlsb/Version.bas | 46 +- 17 files changed, 1762 insertions(+), 1762 deletions(-) diff --git a/Assembler.bas b/Assembler.bas index 84adc77..65d090c 100644 --- a/Assembler.bas +++ b/Assembler.bas @@ -1,532 +1,532 @@ -Attribute VB_Name = "Assembler" -Option Explicit -'Instructions - -'1. Create an Excel file called Assembler.xlsm (for example) in the same folder as Installer.bas: -' *\Excel-Pomodoro-Timer\ - -'2. Open the VB Editor (Alt+F11) right click on the Installer VB Project and choose Import a file and chose: -' *\Excel-Pomodoro-Timer\Assembler.bas - -'3. Run Assemble from the module Assembler (Click somewhere inside the macro and press F5). -' Make sure to wait for the confirmation message at the end before doing anything with Excel. - -'4. Use the tool vbaDeveloper (Available here: https://github.com/DecimalTurn/vbaDeveloper/releases) to import the VBA code. -' - Open vbaDeveloper.xlam -' - Look at the Add-ins ribbon and choose: vbaDeveloper > Import code for ... > Pomodoro_Timer.xlsb - -'5. Save the file - -Public Const SHORT_NAME = "Pomodoro_Timer" -Public Const EXT = ".xlsb" - -Sub Assemble() - - If testFileLocation = False Then - Exit Sub - End If - - On Error Resume Next - Workbooks(SHORT_NAME & EXT).Close SaveChanges:=False - On Error GoTo 0 - - Dim wb As Workbook - Set wb = Workbooks.Add - - Dim sht As Worksheet - Dim sht1 As Worksheet - Dim sht2 As Worksheet - Dim sht3 As Worksheet - Dim sht4 As Worksheet - Dim tmpRng As Range - - Set sht1 = wb.Sheets.Add - sht1.Name = "Pomodoro" - 'Delete any other sheet - For Each sht In wb.Sheets - If sht.Name <> sht1.Name Then - Application.DisplayAlerts = False - sht.Delete - Application.DisplayAlerts = True - End If - Next - 'Create the remaining sheets - Set sht2 = wb.Sheets.Add(After:=Sheets(Sheets.Count)) - sht2.Name = "Summary" - Set sht3 = wb.Sheets.Add(After:=Sheets(Sheets.Count)) - sht3.Name = "Recent" - Set sht4 = wb.Sheets.Add(After:=Sheets(Sheets.Count)) - sht4.Name = "Settings" - - Range("A1").Select - - '******************************* - 'Sheet Pomodoro - '******************************* - Set sht = sht1 - sht.Select - - 'Column width - sht.Columns(1).ColumnWidth = 61.2 / 5 - sht.Columns(2).ColumnWidth = 83.4 / 5 - sht.Columns(3).ColumnWidth = 83.4 / 5 - sht.Columns(4).ColumnWidth = 70.8 / 5 - sht.Columns(5).ColumnWidth = 215.4 / 5 - sht.Columns(6).ColumnWidth = 150.6 / 5 - - 'Cells values - sht.Cells(2, 4).Value2 = "Task Name:" - sht.Cells(8, 1).Value2 = "Date" - sht.Cells(8, 2).Value2 = "Start" - sht.Cells(8, 3).Value2 = "End" - sht.Cells(8, 4).Value2 = "Completed" - sht.Cells(8, 5).Value2 = "Task" - sht.Cells(8, 6).Value2 = "Comment" - - sht.Cells(9, 1).Value2 = DateSerial(2017, 11, 25) - sht.Cells(10, 1).Value2 = DateSerial(2017, 11, 25) - sht.Cells(11, 1).Value2 = DateSerial(2017, 11, 25) - - sht.Cells(9, 2).Value2 = 43064.60846 - sht.Cells(10, 2).Value2 = 43064.69906 - sht.Cells(11, 2).Value2 = 43064.72807 - - sht.Cells(9, 3).Value2 = 43064.62582 - sht.Cells(10, 3).Value2 = 43064.71642 - sht.Cells(11, 3).Value2 = 43064.74543 - - sht.Cells(9, 4).Value2 = True - sht.Cells(10, 4).Value2 = True - sht.Cells(11, 4).Value2 = True - - sht.Cells(9, 5).Value2 = "Check emails" - sht.Cells(10, 5).Value2 = "Make phone call" - sht.Cells(11, 5).Value2 = "Reading" - - 'Bulk formatting - sht.Range(Cells(9, 1), Cells(9, 1).End(xlDown).End(xlDown)).NumberFormat = "YYYY-MM-DD" - sht.Range(Cells(9, 2), Cells(9, 3).End(xlDown).End(xlDown)).NumberFormat = "HH:MM AM/PM" - - 'Cell borders - Dim x As Variant - With sht.Cells(2, 5) - For Each x In Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight) - With .Borders(x) - .LineStyle = xlContinuous - .ColorIndex = 0 - .TintAndShade = 0 - .Weight = xlThin - End With - Next x - End With - - 'Data validation - Range("E2").Select - With Selection.Validation - .Delete - .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ - xlBetween, Formula1:="=Recent!$A$2:$A$10" - .IgnoreBlank = True - .InCellDropdown = True - .InputTitle = "" - .ErrorTitle = "" - .InputMessage = "" - .ErrorMessage = "" - .ShowInput = True - .ShowError = False - End With - - 'Table - sht.ListObjects.Add(xlSrcRange, sht.Range("$A$8:$F$200"), , xlYes).Name = "Table24" - - 'Buttons - Dim bt1 As Button - Set tmpRng = Range("A2:B3") - Set bt1 = sht.Buttons.Add(Left:=tmpRng.Left, Top:=tmpRng.Top, Width:=tmpRng.Width, Height:=tmpRng.Height) - bt1.OnAction = "Pomodoro_Timer.xlsb!PomodoroSession" - bt1.Text = "Start" - - Dim bt2 As Button - Set tmpRng = Range("A5:B6") - Set bt2 = sht.Buttons.Add(Left:=tmpRng.Left, Top:=tmpRng.Top, Width:=tmpRng.Width, Height:=tmpRng.Height) - bt2.OnAction = "Pomodoro_Timer.xlsb!Clear_all_records" - bt2.Text = "Clear Records" - - Range("A1").Select - - '******************************* - 'Summary Sheet - '******************************* - Set sht = sht2 - sht.Select - - 'Column width - sht.Columns(1).ColumnWidth = 131.4 - sht.Columns(2).ColumnWidth = 87 - - 'Pivot Table - ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ - "Table24", Version:=6).CreatePivotTable TableDestination:="'" & sht.Name & "'!R1C1", _ - TableName:="PivotTable1", DefaultVersion:=6 - - With sht.PivotTables("PivotTable1").PivotCache - .RefreshOnFileOpen = False - .MissingItemsLimit = xlMissingItemsDefault - End With - sht.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels - 'Filter - With sht.PivotTables("PivotTable1").PivotFields("Date") - .Orientation = xlPageField - .Position = 1 - End With - 'Row values - With sht.PivotTables("PivotTable1").PivotFields("Task") - .Orientation = xlRowField - .Position = 1 - End With - 'Calculated fields - sht.PivotTables("PivotTable1").CalculatedFields.Add "Duration", _ - "=End - Start", True - sht.PivotTables("PivotTable1").AddDataField sht.PivotTables( _ - "PivotTable1").PivotFields("Duration"), "Duration ", xlSum - - With ActiveSheet.PivotTables("PivotTable1").PivotFields("Duration ") - .NumberFormat = "hh:mm;@" - End With - - 'Buttons - Dim btx As Button - Set btx = sht.Buttons.Add(270, 0.6, 191.4, 28.2) - btx.OnAction = "Pomodoro_Timer.xlsb!Refresh_Summary_PivotTable" - btx.Text = "Refresh Table" - - Range("A1").Select - - '******************************* - 'Recent Sheet - '******************************* - Set sht = sht3 - sht.Select - - 'Column width - sht.Columns(1).ColumnWidth = 140 / 5 - - 'Cell values - sht.Cells(1, 1).Value2 = "Recent Tasks" - sht.Cells(2, 1).Value2 = "Check emails" - sht.Cells(3, 1).Value2 = "Make phone call" - sht.Cells(4, 1).Value2 = "Reading" - - 'Formatting - With sht.Cells(1, 1).Interior - .Pattern = xlSolid - .PatternColorIndex = xlAutomatic - .Color = 12874308 - .TintAndShade = 0 - .PatternTintAndShade = 0 - End With - With sht.Cells(1, 1).Font - .ThemeColor = xlThemeColorDark1 - .TintAndShade = 0 - End With - sht.Cells(1, 1).Font.Bold = True - - 'Buttons - Dim bt3 As Button - Set bt3 = sht.Buttons.Add(270, 0.6, 191.4, 28.2) - bt3.OnAction = "Pomodoro_Timer.xlsb!Clear_Recent_Tasks" - bt3.Text = "Clear Recent Task" - - Range("A1").Select - - '******************************* - 'Settings Sheet - '******************************* - Set sht = sht4 - sht.Select - - 'Column width - sht.Columns(1).ColumnWidth = 200 / 5 - sht.Columns(2).ColumnWidth = 55 / 5 - - 'Cell values - sht.Cells(1, 1).Value2 = "Settings" - sht.Cells(2, 1).Value2 = "Pomodoro duration (min)" - sht.Cells(3, 1).Value2 = "Pomodoro duration (sec)" - sht.Cells(4, 1).Value2 = "Break duration (min)" - sht.Cells(5, 1).Value2 = "Break duration (sec)" - sht.Cells(6, 1).Value2 = "Open Timer in a separate Excel instance" - sht.Cells(7, 1).Value2 = "Reactivate Excel window when timer is closed" - sht.Cells(8, 1).Value2 = "Record unfinished Pomodoro session" - sht.Cells(9, 1).Value2 = "Don't record if session was less than (min)" - sht.Cells(10, 1).Value2 = "Play sound at the end of Pomodoro session" - sht.Cells(11, 1).Value2 = "Play sound at the end of Break" - sht.Cells(12, 1).Value2 = "Use custom position" - sht.Cells(13, 1).Value2 = "Left position" - sht.Cells(14, 1).Value2 = "Top position" - sht.Cells(15, 1).Value2 = "Use shortcuts (F10)" - sht.Cells(16, 1).Value2 = "Flasing color" - - sht.Cells(1, 2).Value2 = "Value" - sht.Cells(2, 2).Value2 = 25 - sht.Cells(3, 2).Value2 = 0 - sht.Cells(4, 2).Value2 = 5 - sht.Cells(5, 2).Value2 = 0 - sht.Cells(6, 2).Value2 = True - sht.Cells(7, 2).Value2 = True - sht.Cells(8, 2).Value2 = True - sht.Cells(9, 2).Value2 = 1 - sht.Cells(10, 2).Value2 = True - sht.Cells(11, 2).Value2 = True - sht.Cells(12, 2).Value2 = False - sht.Cells(13, 2).Value2 = 0.5 - sht.Cells(14, 2).Value2 = 0.5 - sht.Cells(15, 2).Value2 = True - sht.Cells(16, 2).Value2 = "" - - 'Table - sht.ListObjects.Add(xlSrcRange, sht.Range("$A$1:$B$16"), , xlYes).Name = "Table2" - - 'Formatting - With sht.Range("B16").Interior - .Pattern = xlSolid - .PatternColorIndex = xlAutomatic - .Color = 16711680 - .TintAndShade = 0 - .PatternTintAndShade = 0 - End With - - sht.Range("B13:B14").Style = "Percent" - - 'Data validation - sht.Select - Range("B2").Select - With Selection.Validation - .Delete - .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _ - Operator:=xlBetween, Formula1:="0", Formula2:="=24*60" - .IgnoreBlank = True - .InCellDropdown = True - .InputTitle = "" - .ErrorTitle = "" - .InputMessage = "" - .ErrorMessage = "" - .ShowInput = True - .ShowError = True - End With - Range("B3").Select - With Selection.Validation - .Delete - .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _ - Operator:=xlBetween, Formula1:="0", Formula2:="60" - .IgnoreBlank = True - .InCellDropdown = True - .InputTitle = "" - .ErrorTitle = "" - .InputMessage = "" - .ErrorMessage = "" - .ShowInput = True - .ShowError = True - End With - Range("B4").Select - With Selection.Validation - .Delete - .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _ - Operator:=xlBetween, Formula1:="0", Formula2:="=24*60" - .IgnoreBlank = True - .InCellDropdown = True - .InputTitle = "" - .ErrorTitle = "" - .InputMessage = "" - .ErrorMessage = "" - .ShowInput = True - .ShowError = True - End With - Range("B5").Select - With Selection.Validation - .Delete - .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _ - Operator:=xlBetween, Formula1:="0", Formula2:="60" - .IgnoreBlank = True - .InCellDropdown = True - .InputTitle = "" - .ErrorTitle = "" - .InputMessage = "" - .ErrorMessage = "" - .ShowInput = True - .ShowError = True - End With - Range("B6").Select - With Selection.Validation - .Delete - .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ - xlBetween, Formula1:="TRUE,FALSE" - .IgnoreBlank = True - .InCellDropdown = True - .InputTitle = "" - .ErrorTitle = "" - .InputMessage = "" - .ErrorMessage = "" - .ShowInput = True - .ShowError = True - End With - Range("B7").Select - With Selection.Validation - .Delete - .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ - xlBetween, Formula1:="TRUE,FALSE" - .IgnoreBlank = True - .InCellDropdown = True - .InputTitle = "" - .ErrorTitle = "" - .InputMessage = "" - .ErrorMessage = "" - .ShowInput = True - .ShowError = True - End With - Range("B8").Select - With Selection.Validation - .Delete - .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ - xlBetween, Formula1:="TRUE,FALSE" - .IgnoreBlank = True - .InCellDropdown = True - .InputTitle = "" - .ErrorTitle = "" - .InputMessage = "" - .ErrorMessage = "" - .ShowInput = True - .ShowError = True - End With - Range("B9").Select - With Selection.Validation - .Delete - .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _ - Operator:=xlBetween, Formula1:="1", Formula2:="=B2" - .IgnoreBlank = True - .InCellDropdown = True - .InputTitle = "" - .ErrorTitle = "" - .InputMessage = "" - .ErrorMessage = "" - .ShowInput = True - .ShowError = True - End With - Range("B10").Select - With Selection.Validation - .Delete - .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ - xlBetween, Formula1:="TRUE,FALSE" - .IgnoreBlank = True - .InCellDropdown = True - .InputTitle = "" - .ErrorTitle = "" - .InputMessage = "" - .ErrorMessage = "" - .ShowInput = True - .ShowError = True - End With - Range("B11").Select - With Selection.Validation - .Delete - .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ - xlBetween, Formula1:="TRUE,FALSE" - .IgnoreBlank = True - .InCellDropdown = True - .InputTitle = "" - .ErrorTitle = "" - .InputMessage = "" - .ErrorMessage = "" - .ShowInput = True - .ShowError = True - End With - Range("B12").Select - With Selection.Validation - .Delete - .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ - xlBetween, Formula1:="TRUE,FALSE" - .IgnoreBlank = True - .InCellDropdown = True - .InputTitle = "" - .ErrorTitle = "" - .InputMessage = "" - .ErrorMessage = "" - .ShowInput = True - .ShowError = True - End With - Range("B13").Select - With Selection.Validation - .Delete - .Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator _ - :=xlBetween, Formula1:="0", Formula2:="100" - .IgnoreBlank = True - .InCellDropdown = True - .InputTitle = "" - .ErrorTitle = "" - .InputMessage = "" - .ErrorMessage = "" - .ShowInput = True - .ShowError = True - End With - Range("B14").Select - With Selection.Validation - .Delete - .Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator _ - :=xlBetween, Formula1:="0", Formula2:="100" - .IgnoreBlank = True - .InCellDropdown = True - .InputTitle = "" - .ErrorTitle = "" - .InputMessage = "" - .ErrorMessage = "" - .ShowInput = True - .ShowError = True - End With - Range("B15").Select - With Selection.Validation - .Delete - .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ - xlBetween, Formula1:="TRUE,FALSE" - .IgnoreBlank = True - .InCellDropdown = True - .InputTitle = "" - .ErrorTitle = "" - .InputMessage = "" - .ErrorMessage = "" - .ShowInput = True - .ShowError = True - End With - - Range("A1").Select - - Sheets("Pomodoro").Select - wb.SaveAs Filename:=ThisWorkbook.Path & "\" & SHORT_NAME & EXT, FileFormat:=xlExcel12 - -End Sub - - -Function testFileLocation() As Boolean - - Dim ErrMsg As String - - 'Test if this workbook has been saved - Dim FileEverSaved As Boolean - If ThisWorkbook.Path = "" Then - ErrMsg = "Please save the file that contains the Assembler module in the same folder than Installer.bas and try again" - MsgBox ErrMsg, vbCritical - testFileLocation = False - Exit Function - End If - - 'Test if the src folder contains a folder with the right name - Dim SourceFolderExist As Boolean - If Dir(ThisWorkbook.Path & "\src\" & SHORT_NAME & EXT, vbDirectory) = "" Then - ErrMsg = "Please save the file that contains the Assembler module in a location where the source folder (src) contains a folder named " & SHORT_NAME & EXT - MsgBox ErrMsg, vbCritical - testFileLocation = False - Exit Function - End If - - testFileLocation = True - -End Function +Attribute VB_Name = "Assembler" +Option Explicit +'Instructions + +'1. Create an Excel file called Assembler.xlsm (for example) in the same folder as Installer.bas: +' *\Excel-Pomodoro-Timer\ + +'2. Open the VB Editor (Alt+F11) right click on the Installer VB Project and choose Import a file and chose: +' *\Excel-Pomodoro-Timer\Assembler.bas + +'3. Run Assemble from the module Assembler (Click somewhere inside the macro and press F5). +' Make sure to wait for the confirmation message at the end before doing anything with Excel. + +'4. Use the tool vbaDeveloper (Available here: https://github.com/DecimalTurn/vbaDeveloper/releases) to import the VBA code. +' - Open vbaDeveloper.xlam +' - Look at the Add-ins ribbon and choose: vbaDeveloper > Import code for ... > Pomodoro_Timer.xlsb + +'5. Save the file + +Public Const SHORT_NAME = "Pomodoro_Timer" +Public Const EXT = ".xlsb" + +Sub Assemble() + + If testFileLocation = False Then + Exit Sub + End If + + On Error Resume Next + Workbooks(SHORT_NAME & EXT).Close SaveChanges:=False + On Error GoTo 0 + + Dim wb As Workbook + Set wb = Workbooks.Add + + Dim sht As Worksheet + Dim sht1 As Worksheet + Dim sht2 As Worksheet + Dim sht3 As Worksheet + Dim sht4 As Worksheet + Dim tmpRng As Range + + Set sht1 = wb.Sheets.Add + sht1.Name = "Pomodoro" + 'Delete any other sheet + For Each sht In wb.Sheets + If sht.Name <> sht1.Name Then + Application.DisplayAlerts = False + sht.Delete + Application.DisplayAlerts = True + End If + Next + 'Create the remaining sheets + Set sht2 = wb.Sheets.Add(After:=Sheets(Sheets.Count)) + sht2.Name = "Summary" + Set sht3 = wb.Sheets.Add(After:=Sheets(Sheets.Count)) + sht3.Name = "Recent" + Set sht4 = wb.Sheets.Add(After:=Sheets(Sheets.Count)) + sht4.Name = "Settings" + + Range("A1").Select + + '******************************* + 'Sheet Pomodoro + '******************************* + Set sht = sht1 + sht.Select + + 'Column width + sht.Columns(1).ColumnWidth = 61.2 / 5 + sht.Columns(2).ColumnWidth = 83.4 / 5 + sht.Columns(3).ColumnWidth = 83.4 / 5 + sht.Columns(4).ColumnWidth = 70.8 / 5 + sht.Columns(5).ColumnWidth = 215.4 / 5 + sht.Columns(6).ColumnWidth = 150.6 / 5 + + 'Cells values + sht.Cells(2, 4).Value2 = "Task Name:" + sht.Cells(8, 1).Value2 = "Date" + sht.Cells(8, 2).Value2 = "Start" + sht.Cells(8, 3).Value2 = "End" + sht.Cells(8, 4).Value2 = "Completed" + sht.Cells(8, 5).Value2 = "Task" + sht.Cells(8, 6).Value2 = "Comment" + + sht.Cells(9, 1).Value2 = DateSerial(2017, 11, 25) + sht.Cells(10, 1).Value2 = DateSerial(2017, 11, 25) + sht.Cells(11, 1).Value2 = DateSerial(2017, 11, 25) + + sht.Cells(9, 2).Value2 = 43064.60846 + sht.Cells(10, 2).Value2 = 43064.69906 + sht.Cells(11, 2).Value2 = 43064.72807 + + sht.Cells(9, 3).Value2 = 43064.62582 + sht.Cells(10, 3).Value2 = 43064.71642 + sht.Cells(11, 3).Value2 = 43064.74543 + + sht.Cells(9, 4).Value2 = True + sht.Cells(10, 4).Value2 = True + sht.Cells(11, 4).Value2 = True + + sht.Cells(9, 5).Value2 = "Check emails" + sht.Cells(10, 5).Value2 = "Make phone call" + sht.Cells(11, 5).Value2 = "Reading" + + 'Bulk formatting + sht.Range(Cells(9, 1), Cells(9, 1).End(xlDown).End(xlDown)).NumberFormat = "YYYY-MM-DD" + sht.Range(Cells(9, 2), Cells(9, 3).End(xlDown).End(xlDown)).NumberFormat = "HH:MM AM/PM" + + 'Cell borders + Dim x As Variant + With sht.Cells(2, 5) + For Each x In Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight) + With .Borders(x) + .LineStyle = xlContinuous + .ColorIndex = 0 + .TintAndShade = 0 + .Weight = xlThin + End With + Next x + End With + + 'Data validation + Range("E2").Select + With Selection.Validation + .Delete + .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ + xlBetween, Formula1:="=Recent!$A$2:$A$10" + .IgnoreBlank = True + .InCellDropdown = True + .InputTitle = "" + .ErrorTitle = "" + .InputMessage = "" + .ErrorMessage = "" + .ShowInput = True + .ShowError = False + End With + + 'Table + sht.ListObjects.Add(xlSrcRange, sht.Range("$A$8:$F$200"), , xlYes).Name = "Table24" + + 'Buttons + Dim bt1 As Button + Set tmpRng = Range("A2:B3") + Set bt1 = sht.Buttons.Add(Left:=tmpRng.Left, Top:=tmpRng.Top, Width:=tmpRng.Width, Height:=tmpRng.Height) + bt1.OnAction = "Pomodoro_Timer.xlsb!PomodoroSession" + bt1.Text = "Start" + + Dim bt2 As Button + Set tmpRng = Range("A5:B6") + Set bt2 = sht.Buttons.Add(Left:=tmpRng.Left, Top:=tmpRng.Top, Width:=tmpRng.Width, Height:=tmpRng.Height) + bt2.OnAction = "Pomodoro_Timer.xlsb!Clear_all_records" + bt2.Text = "Clear Records" + + Range("A1").Select + + '******************************* + 'Summary Sheet + '******************************* + Set sht = sht2 + sht.Select + + 'Column width + sht.Columns(1).ColumnWidth = 131.4 + sht.Columns(2).ColumnWidth = 87 + + 'Pivot Table + ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ + "Table24", Version:=6).CreatePivotTable TableDestination:="'" & sht.Name & "'!R1C1", _ + TableName:="PivotTable1", DefaultVersion:=6 + + With sht.PivotTables("PivotTable1").PivotCache + .RefreshOnFileOpen = False + .MissingItemsLimit = xlMissingItemsDefault + End With + sht.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels + 'Filter + With sht.PivotTables("PivotTable1").PivotFields("Date") + .Orientation = xlPageField + .Position = 1 + End With + 'Row values + With sht.PivotTables("PivotTable1").PivotFields("Task") + .Orientation = xlRowField + .Position = 1 + End With + 'Calculated fields + sht.PivotTables("PivotTable1").CalculatedFields.Add "Duration", _ + "=End - Start", True + sht.PivotTables("PivotTable1").AddDataField sht.PivotTables( _ + "PivotTable1").PivotFields("Duration"), "Duration ", xlSum + + With ActiveSheet.PivotTables("PivotTable1").PivotFields("Duration ") + .NumberFormat = "hh:mm;@" + End With + + 'Buttons + Dim btx As Button + Set btx = sht.Buttons.Add(270, 0.6, 191.4, 28.2) + btx.OnAction = "Pomodoro_Timer.xlsb!Refresh_Summary_PivotTable" + btx.Text = "Refresh Table" + + Range("A1").Select + + '******************************* + 'Recent Sheet + '******************************* + Set sht = sht3 + sht.Select + + 'Column width + sht.Columns(1).ColumnWidth = 140 / 5 + + 'Cell values + sht.Cells(1, 1).Value2 = "Recent Tasks" + sht.Cells(2, 1).Value2 = "Check emails" + sht.Cells(3, 1).Value2 = "Make phone call" + sht.Cells(4, 1).Value2 = "Reading" + + 'Formatting + With sht.Cells(1, 1).Interior + .Pattern = xlSolid + .PatternColorIndex = xlAutomatic + .Color = 12874308 + .TintAndShade = 0 + .PatternTintAndShade = 0 + End With + With sht.Cells(1, 1).Font + .ThemeColor = xlThemeColorDark1 + .TintAndShade = 0 + End With + sht.Cells(1, 1).Font.Bold = True + + 'Buttons + Dim bt3 As Button + Set bt3 = sht.Buttons.Add(270, 0.6, 191.4, 28.2) + bt3.OnAction = "Pomodoro_Timer.xlsb!Clear_Recent_Tasks" + bt3.Text = "Clear Recent Task" + + Range("A1").Select + + '******************************* + 'Settings Sheet + '******************************* + Set sht = sht4 + sht.Select + + 'Column width + sht.Columns(1).ColumnWidth = 200 / 5 + sht.Columns(2).ColumnWidth = 55 / 5 + + 'Cell values + sht.Cells(1, 1).Value2 = "Settings" + sht.Cells(2, 1).Value2 = "Pomodoro duration (min)" + sht.Cells(3, 1).Value2 = "Pomodoro duration (sec)" + sht.Cells(4, 1).Value2 = "Break duration (min)" + sht.Cells(5, 1).Value2 = "Break duration (sec)" + sht.Cells(6, 1).Value2 = "Open Timer in a separate Excel instance" + sht.Cells(7, 1).Value2 = "Reactivate Excel window when timer is closed" + sht.Cells(8, 1).Value2 = "Record unfinished Pomodoro session" + sht.Cells(9, 1).Value2 = "Don't record if session was less than (min)" + sht.Cells(10, 1).Value2 = "Play sound at the end of Pomodoro session" + sht.Cells(11, 1).Value2 = "Play sound at the end of Break" + sht.Cells(12, 1).Value2 = "Use custom position" + sht.Cells(13, 1).Value2 = "Left position" + sht.Cells(14, 1).Value2 = "Top position" + sht.Cells(15, 1).Value2 = "Use shortcuts (F10)" + sht.Cells(16, 1).Value2 = "Flasing color" + + sht.Cells(1, 2).Value2 = "Value" + sht.Cells(2, 2).Value2 = 25 + sht.Cells(3, 2).Value2 = 0 + sht.Cells(4, 2).Value2 = 5 + sht.Cells(5, 2).Value2 = 0 + sht.Cells(6, 2).Value2 = True + sht.Cells(7, 2).Value2 = True + sht.Cells(8, 2).Value2 = True + sht.Cells(9, 2).Value2 = 1 + sht.Cells(10, 2).Value2 = True + sht.Cells(11, 2).Value2 = True + sht.Cells(12, 2).Value2 = False + sht.Cells(13, 2).Value2 = 0.5 + sht.Cells(14, 2).Value2 = 0.5 + sht.Cells(15, 2).Value2 = True + sht.Cells(16, 2).Value2 = "" + + 'Table + sht.ListObjects.Add(xlSrcRange, sht.Range("$A$1:$B$16"), , xlYes).Name = "Table2" + + 'Formatting + With sht.Range("B16").Interior + .Pattern = xlSolid + .PatternColorIndex = xlAutomatic + .Color = 16711680 + .TintAndShade = 0 + .PatternTintAndShade = 0 + End With + + sht.Range("B13:B14").Style = "Percent" + + 'Data validation + sht.Select + Range("B2").Select + With Selection.Validation + .Delete + .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _ + Operator:=xlBetween, Formula1:="0", Formula2:="=24*60" + .IgnoreBlank = True + .InCellDropdown = True + .InputTitle = "" + .ErrorTitle = "" + .InputMessage = "" + .ErrorMessage = "" + .ShowInput = True + .ShowError = True + End With + Range("B3").Select + With Selection.Validation + .Delete + .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _ + Operator:=xlBetween, Formula1:="0", Formula2:="60" + .IgnoreBlank = True + .InCellDropdown = True + .InputTitle = "" + .ErrorTitle = "" + .InputMessage = "" + .ErrorMessage = "" + .ShowInput = True + .ShowError = True + End With + Range("B4").Select + With Selection.Validation + .Delete + .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _ + Operator:=xlBetween, Formula1:="0", Formula2:="=24*60" + .IgnoreBlank = True + .InCellDropdown = True + .InputTitle = "" + .ErrorTitle = "" + .InputMessage = "" + .ErrorMessage = "" + .ShowInput = True + .ShowError = True + End With + Range("B5").Select + With Selection.Validation + .Delete + .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _ + Operator:=xlBetween, Formula1:="0", Formula2:="60" + .IgnoreBlank = True + .InCellDropdown = True + .InputTitle = "" + .ErrorTitle = "" + .InputMessage = "" + .ErrorMessage = "" + .ShowInput = True + .ShowError = True + End With + Range("B6").Select + With Selection.Validation + .Delete + .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ + xlBetween, Formula1:="TRUE,FALSE" + .IgnoreBlank = True + .InCellDropdown = True + .InputTitle = "" + .ErrorTitle = "" + .InputMessage = "" + .ErrorMessage = "" + .ShowInput = True + .ShowError = True + End With + Range("B7").Select + With Selection.Validation + .Delete + .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ + xlBetween, Formula1:="TRUE,FALSE" + .IgnoreBlank = True + .InCellDropdown = True + .InputTitle = "" + .ErrorTitle = "" + .InputMessage = "" + .ErrorMessage = "" + .ShowInput = True + .ShowError = True + End With + Range("B8").Select + With Selection.Validation + .Delete + .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ + xlBetween, Formula1:="TRUE,FALSE" + .IgnoreBlank = True + .InCellDropdown = True + .InputTitle = "" + .ErrorTitle = "" + .InputMessage = "" + .ErrorMessage = "" + .ShowInput = True + .ShowError = True + End With + Range("B9").Select + With Selection.Validation + .Delete + .Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _ + Operator:=xlBetween, Formula1:="1", Formula2:="=B2" + .IgnoreBlank = True + .InCellDropdown = True + .InputTitle = "" + .ErrorTitle = "" + .InputMessage = "" + .ErrorMessage = "" + .ShowInput = True + .ShowError = True + End With + Range("B10").Select + With Selection.Validation + .Delete + .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ + xlBetween, Formula1:="TRUE,FALSE" + .IgnoreBlank = True + .InCellDropdown = True + .InputTitle = "" + .ErrorTitle = "" + .InputMessage = "" + .ErrorMessage = "" + .ShowInput = True + .ShowError = True + End With + Range("B11").Select + With Selection.Validation + .Delete + .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ + xlBetween, Formula1:="TRUE,FALSE" + .IgnoreBlank = True + .InCellDropdown = True + .InputTitle = "" + .ErrorTitle = "" + .InputMessage = "" + .ErrorMessage = "" + .ShowInput = True + .ShowError = True + End With + Range("B12").Select + With Selection.Validation + .Delete + .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ + xlBetween, Formula1:="TRUE,FALSE" + .IgnoreBlank = True + .InCellDropdown = True + .InputTitle = "" + .ErrorTitle = "" + .InputMessage = "" + .ErrorMessage = "" + .ShowInput = True + .ShowError = True + End With + Range("B13").Select + With Selection.Validation + .Delete + .Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator _ + :=xlBetween, Formula1:="0", Formula2:="100" + .IgnoreBlank = True + .InCellDropdown = True + .InputTitle = "" + .ErrorTitle = "" + .InputMessage = "" + .ErrorMessage = "" + .ShowInput = True + .ShowError = True + End With + Range("B14").Select + With Selection.Validation + .Delete + .Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator _ + :=xlBetween, Formula1:="0", Formula2:="100" + .IgnoreBlank = True + .InCellDropdown = True + .InputTitle = "" + .ErrorTitle = "" + .InputMessage = "" + .ErrorMessage = "" + .ShowInput = True + .ShowError = True + End With + Range("B15").Select + With Selection.Validation + .Delete + .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ + xlBetween, Formula1:="TRUE,FALSE" + .IgnoreBlank = True + .InCellDropdown = True + .InputTitle = "" + .ErrorTitle = "" + .InputMessage = "" + .ErrorMessage = "" + .ShowInput = True + .ShowError = True + End With + + Range("A1").Select + + Sheets("Pomodoro").Select + wb.SaveAs Filename:=ThisWorkbook.Path & "\" & SHORT_NAME & EXT, FileFormat:=xlExcel12 + +End Sub + + +Function testFileLocation() As Boolean + + Dim ErrMsg As String + + 'Test if this workbook has been saved + Dim FileEverSaved As Boolean + If ThisWorkbook.Path = "" Then + ErrMsg = "Please save the file that contains the Assembler module in the same folder than Installer.bas and try again" + MsgBox ErrMsg, vbCritical + testFileLocation = False + Exit Function + End If + + 'Test if the src folder contains a folder with the right name + Dim SourceFolderExist As Boolean + If Dir(ThisWorkbook.Path & "\src\" & SHORT_NAME & EXT, vbDirectory) = "" Then + ErrMsg = "Please save the file that contains the Assembler module in a location where the source folder (src) contains a folder named " & SHORT_NAME & EXT + MsgBox ErrMsg, vbCritical + testFileLocation = False + Exit Function + End If + + testFileLocation = True + +End Function diff --git a/src/Pomodoro_Timer.xlsb/API_AlwaysOnTop.bas b/src/Pomodoro_Timer.xlsb/API_AlwaysOnTop.bas index ac26592..639d5d0 100644 --- a/src/Pomodoro_Timer.xlsb/API_AlwaysOnTop.bas +++ b/src/Pomodoro_Timer.xlsb/API_AlwaysOnTop.bas @@ -1,62 +1,62 @@ -Attribute VB_Name = "API_AlwaysOnTop" -'REFERENCE: https://www.mrexcel.com/forum/excel-questions/386643-userform-always-top-2.html -'PURPOSE: This module includes the functions used to make sure that the Timer stays on top of all windows. - -Option Explicit - -Public Const SWP_NOMOVE = &H2 -Public Const SWP_NOSIZE = &H1 - -' For hWndInsertAfter in SetWindowPos -Public Enum HWND_TYPE - HWND_TOP = 0 - HWND_NOTOPMOST = -2 - HWND_TOPMOST = -1 - HWND_BOTTOM = 1 -End Enum - -'https://msdn.microsoft.com/en-us/library/office/gg264421.aspx -'64-Bit Visual Basic for Applications Overview -'See also: https://sysmod.wordpress.com/2016/09/03/conditional-compilation-vba-excel-macwin3264/ -'For Mac declarations - - -#If VBA7 Then ' Excel 2010 or later for Windows - - 'VBA version 7 compiler, therefore >= Office 2010 - 'PtrSafe means function works in 32-bit and 64-bit Office - 'LongPtr type alias resolves to Long (32 bits) in 32-bit Office, or LongLong (64 bits) in 64-bit Office - - Public Declare PtrSafe Function SetWindowPos Lib "user32" _ - (ByVal hWnd As LongPtr, _ - ByVal hWndInsertAfter As LongPtr, _ - ByVal x As Long, _ - ByVal Y As Long, _ - ByVal cx As Long, _ - ByVal cy As Long, _ - ByVal uFlags As Long) As Long - - Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _ - (ByVal lpClassName As String, _ - ByVal lpWindowName As String) As LongPtr - -#Else ' pre Excel 2010 for Windows - 'VBA version 6 or earlier compiler, therefore <= Office 2007 - - Public Declare Function SetWindowPos Lib "user32" _ - (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 uFlags As Long) As Long - - Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ - (ByVal lpClassName As String, _ - ByVal lpWindowName As String) As Long - -#End If - - - +Attribute VB_Name = "API_AlwaysOnTop" +'REFERENCE: https://www.mrexcel.com/forum/excel-questions/386643-userform-always-top-2.html +'PURPOSE: This module includes the functions used to make sure that the Timer stays on top of all windows. + +Option Explicit + +Public Const SWP_NOMOVE = &H2 +Public Const SWP_NOSIZE = &H1 + +' For hWndInsertAfter in SetWindowPos +Public Enum HWND_TYPE + HWND_TOP = 0 + HWND_NOTOPMOST = -2 + HWND_TOPMOST = -1 + HWND_BOTTOM = 1 +End Enum + +'https://msdn.microsoft.com/en-us/library/office/gg264421.aspx +'64-Bit Visual Basic for Applications Overview +'See also: https://sysmod.wordpress.com/2016/09/03/conditional-compilation-vba-excel-macwin3264/ +'For Mac declarations + + +#If VBA7 Then ' Excel 2010 or later for Windows + + 'VBA version 7 compiler, therefore >= Office 2010 + 'PtrSafe means function works in 32-bit and 64-bit Office + 'LongPtr type alias resolves to Long (32 bits) in 32-bit Office, or LongLong (64 bits) in 64-bit Office + + Public Declare PtrSafe Function SetWindowPos Lib "user32" _ + (ByVal hWnd As LongPtr, _ + ByVal hWndInsertAfter As LongPtr, _ + ByVal x As Long, _ + ByVal Y As Long, _ + ByVal cx As Long, _ + ByVal cy As Long, _ + ByVal uFlags As Long) As Long + + Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _ + (ByVal lpClassName As String, _ + ByVal lpWindowName As String) As LongPtr + +#Else ' pre Excel 2010 for Windows + 'VBA version 6 or earlier compiler, therefore <= Office 2007 + + Public Declare Function SetWindowPos Lib "user32" _ + (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 uFlags As Long) As Long + + Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ + (ByVal lpClassName As String, _ + ByVal lpWindowName As String) As Long + +#End If + + + diff --git a/src/Pomodoro_Timer.xlsb/API_Maximize.bas b/src/Pomodoro_Timer.xlsb/API_Maximize.bas index 07340d0..674c0d5 100644 --- a/src/Pomodoro_Timer.xlsb/API_Maximize.bas +++ b/src/Pomodoro_Timer.xlsb/API_Maximize.bas @@ -1,32 +1,32 @@ -Attribute VB_Name = "API_Maximize" -'PURPOSE: Contain function that allows to maximize or minimize a window. -'REFERENCE: http://www.vbaexpress.com/forum/archive/index.php/t-36677.html - -Option Explicit - -#If VBA7 Then - - Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal nCmdShow As Long) As Long - Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr -#Else - Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long - Declare Function GetForegroundWindow Lib "user32" () As Long -#End If - -' ShowWindow() Commands -Public Const SW_HIDE = 0 -Public Const SW_SHOWNORMAL = 1 -Public Const SW_NORMAL = 1 -Public Const SW_SHOWMINIMIZED = 2 -Public Const SW_SHOWMAXIMIZED = 3 -Public Const SW_MAXIMIZE = 3 -Public Const SW_SHOWNOACTIVATE = 4 -Public Const SW_SHOW = 5 -Public Const SW_MINIMIZE = 6 -Public Const SW_SHOWMINNOACTIVE = 7 -Public Const SW_SHOWNA = 8 -Public Const SW_RESTORE = 9 -Public Const SW_SHOWDEFAULT = 10 -Public Const SW_MAX = 10 - - +Attribute VB_Name = "API_Maximize" +'PURPOSE: Contain function that allows to maximize or minimize a window. +'REFERENCE: http://www.vbaexpress.com/forum/archive/index.php/t-36677.html + +Option Explicit + +#If VBA7 Then + + Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal nCmdShow As Long) As Long + Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr +#Else + Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long + Declare Function GetForegroundWindow Lib "user32" () As Long +#End If + +' ShowWindow() Commands +Public Const SW_HIDE = 0 +Public Const SW_SHOWNORMAL = 1 +Public Const SW_NORMAL = 1 +Public Const SW_SHOWMINIMIZED = 2 +Public Const SW_SHOWMAXIMIZED = 3 +Public Const SW_MAXIMIZE = 3 +Public Const SW_SHOWNOACTIVATE = 4 +Public Const SW_SHOW = 5 +Public Const SW_MINIMIZE = 6 +Public Const SW_SHOWMINNOACTIVE = 7 +Public Const SW_SHOWNA = 8 +Public Const SW_RESTORE = 9 +Public Const SW_SHOWDEFAULT = 10 +Public Const SW_MAX = 10 + + diff --git a/src/Pomodoro_Timer.xlsb/API_Pixel.bas b/src/Pomodoro_Timer.xlsb/API_Pixel.bas index 3d243e3..494098c 100644 --- a/src/Pomodoro_Timer.xlsb/API_Pixel.bas +++ b/src/Pomodoro_Timer.xlsb/API_Pixel.bas @@ -1,70 +1,70 @@ -Attribute VB_Name = "API_Pixel" -'PURPOSE: This module have functions to help convert pixels to points in Excel, allowing to scale things. -'REFERENCE: http://www.vbaexpress.com/forum/showthread.php?21896-Pixel-to-Point-ratio - -Option Explicit - -#If VBA7 Then - Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr - Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hdc As LongPtr) As Long - Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long -#Else - Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long - Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long - Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long -#End If - -Private Const LOGPIXELSX As Long = 88 -Private Const LOGPIXELSY As Long = 90 - -Function PointPerPixelX() As Double - #If VBA7 Then - Dim hdc As LongPtr - #Else - Dim hdc As Long - #End If - hdc = GetDC(0) - PointPerPixelX = 1 / (GetDeviceCaps(hdc, LOGPIXELSX) / 72) -End Function - -Function PointPerPixelY() As Double - #If VBA7 Then - Dim hdc As LongPtr - #Else - Dim hdc As Long - #End If - hdc = GetDC(0) - PointPerPixelY = 1 / (GetDeviceCaps(hdc, LOGPIXELSY) / 72) -End Function - -Sub Example() - #If VBA7 Then - Dim hdc As LongPtr - #Else - Dim hdc As Long - #End If - Dim PixPerInchX As Long - Dim PixPerInchY As Long - Dim PixPerPtX As Double - Dim PixPerPtY As Double - Dim PtPerPixX As Double - Dim PtPerPixY As Double - - hdc = GetDC(0) - - PixPerInchX = GetDeviceCaps(hdc, LOGPIXELSX) - PixPerInchY = GetDeviceCaps(hdc, LOGPIXELSY) - - 'there are 72 points per inch - PixPerPtX = PixPerInchX / 72 - PixPerPtY = PixPerInchY / 72 - - Debug.Print "PixPerPtX: " & PixPerPtX, "PixPerPtY: " & PixPerPtY - - PtPerPixX = 1 / PixPerPtX - PtPerPixY = 1 / PixPerPtY - - Debug.Print "PtPerPixX: " & PtPerPixX, "PtPerPixY: " & PtPerPixX - ReleaseDC 0, hdc -End Sub - +Attribute VB_Name = "API_Pixel" +'PURPOSE: This module have functions to help convert pixels to points in Excel, allowing to scale things. +'REFERENCE: http://www.vbaexpress.com/forum/showthread.php?21896-Pixel-to-Point-ratio + +Option Explicit + +#If VBA7 Then + Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr + Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hdc As LongPtr) As Long + Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long +#Else + Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long + Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long + Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long +#End If + +Private Const LOGPIXELSX As Long = 88 +Private Const LOGPIXELSY As Long = 90 + +Function PointPerPixelX() As Double + #If VBA7 Then + Dim hdc As LongPtr + #Else + Dim hdc As Long + #End If + hdc = GetDC(0) + PointPerPixelX = 1 / (GetDeviceCaps(hdc, LOGPIXELSX) / 72) +End Function + +Function PointPerPixelY() As Double + #If VBA7 Then + Dim hdc As LongPtr + #Else + Dim hdc As Long + #End If + hdc = GetDC(0) + PointPerPixelY = 1 / (GetDeviceCaps(hdc, LOGPIXELSY) / 72) +End Function + +Sub Example() + #If VBA7 Then + Dim hdc As LongPtr + #Else + Dim hdc As Long + #End If + Dim PixPerInchX As Long + Dim PixPerInchY As Long + Dim PixPerPtX As Double + Dim PixPerPtY As Double + Dim PtPerPixX As Double + Dim PtPerPixY As Double + + hdc = GetDC(0) + + PixPerInchX = GetDeviceCaps(hdc, LOGPIXELSX) + PixPerInchY = GetDeviceCaps(hdc, LOGPIXELSY) + + 'there are 72 points per inch + PixPerPtX = PixPerInchX / 72 + PixPerPtY = PixPerInchY / 72 + + Debug.Print "PixPerPtX: " & PixPerPtX, "PixPerPtY: " & PixPerPtY + + PtPerPixX = 1 / PixPerPtX + PtPerPixY = 1 / PixPerPtY + + Debug.Print "PtPerPixX: " & PtPerPixX, "PtPerPixY: " & PtPerPixX + ReleaseDC 0, hdc +End Sub + diff --git a/src/Pomodoro_Timer.xlsb/API_Sleep.bas b/src/Pomodoro_Timer.xlsb/API_Sleep.bas index 1f4806f..3bd99ac 100644 --- a/src/Pomodoro_Timer.xlsb/API_Sleep.bas +++ b/src/Pomodoro_Timer.xlsb/API_Sleep.bas @@ -1,21 +1,21 @@ -Attribute VB_Name = "API_Sleep" -'PURPOSE: Define the sleep function to stop the code from running and releasing CPU usage. - -Option Explicit - -#If VBA7 Then ' Excel 2010 or later for Windows - - Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 64 Bit Systems - -#Else ' pre Excel 2010 for Windows - - Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems - -#End If - - -Sub SleepTest() -'MsgBox "Execution is started" -Sleep 10000 'delay in milliseconds -MsgBox "Waiting completed" -End Sub +Attribute VB_Name = "API_Sleep" +'PURPOSE: Define the sleep function to stop the code from running and releasing CPU usage. + +Option Explicit + +#If VBA7 Then ' Excel 2010 or later for Windows + + Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 64 Bit Systems + +#Else ' pre Excel 2010 for Windows + + Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems + +#End If + + +Sub SleepTest() +'MsgBox "Execution is started" +Sleep 10000 'delay in milliseconds +MsgBox "Waiting completed" +End Sub diff --git a/src/Pomodoro_Timer.xlsb/API_WorkArea.bas b/src/Pomodoro_Timer.xlsb/API_WorkArea.bas index 93c9757..91e51a9 100644 --- a/src/Pomodoro_Timer.xlsb/API_WorkArea.bas +++ b/src/Pomodoro_Timer.xlsb/API_WorkArea.bas @@ -1,43 +1,43 @@ -Attribute VB_Name = "API_WorkArea" -'PURPOSE: Get screen size in pixels -'REFERENCE: https://www.excelforum.com/excel-programming-vba-macros/565556-why-does-spi_getworkarea-come-in-too-large.html - -Option Explicit - -Private Const SPI_GETWORKAREA = 48 - -#If VBA7 Then - Private Declare PtrSafe Function SystemParametersInfo Lib "user32" _ - Alias "SystemParametersInfoA" (ByVal uAction As Long, _ - ByVal uParam As Long, ByRef lpvParam As Any, _ - ByVal fuWinIni As Long) As Long -#Else - Private Declare Function SystemParametersInfo Lib "user32" _ - Alias "SystemParametersInfoA" (ByVal uAction As Long, _ - ByVal uParam As Long, ByRef lpvParam As Any, _ - ByVal fuWinIni As Long) As Long -#End If - -Private Type RECT -Left As Long -Top As Long -Right As Long -Bottom As Long -End Type - -Function GETWORKAREA_HEIGHT() As Double -'PURPOSE: Get the screen size exluding the taskbar - Dim nRect As RECT - SystemParametersInfo SPI_GETWORKAREA, 0, nRect, 0 - GETWORKAREA_HEIGHT = (nRect.Bottom - nRect.Top) -End Function - - -Function GETWORKAREA_WIDTH() As Double -'PURPOSE: Get the screen size exluding the taskbar - Dim nRect As RECT - SystemParametersInfo SPI_GETWORKAREA, 0, nRect, 0 - GETWORKAREA_WIDTH = (nRect.Right - nRect.Left) -End Function - - +Attribute VB_Name = "API_WorkArea" +'PURPOSE: Get screen size in pixels +'REFERENCE: https://www.excelforum.com/excel-programming-vba-macros/565556-why-does-spi_getworkarea-come-in-too-large.html + +Option Explicit + +Private Const SPI_GETWORKAREA = 48 + +#If VBA7 Then + Private Declare PtrSafe Function SystemParametersInfo Lib "user32" _ + Alias "SystemParametersInfoA" (ByVal uAction As Long, _ + ByVal uParam As Long, ByRef lpvParam As Any, _ + ByVal fuWinIni As Long) As Long +#Else + Private Declare Function SystemParametersInfo Lib "user32" _ + Alias "SystemParametersInfoA" (ByVal uAction As Long, _ + ByVal uParam As Long, ByRef lpvParam As Any, _ + ByVal fuWinIni As Long) As Long +#End If + +Private Type RECT +Left As Long +Top As Long +Right As Long +Bottom As Long +End Type + +Function GETWORKAREA_HEIGHT() As Double +'PURPOSE: Get the screen size exluding the taskbar + Dim nRect As RECT + SystemParametersInfo SPI_GETWORKAREA, 0, nRect, 0 + GETWORKAREA_HEIGHT = (nRect.Bottom - nRect.Top) +End Function + + +Function GETWORKAREA_WIDTH() As Double +'PURPOSE: Get the screen size exluding the taskbar + Dim nRect As RECT + SystemParametersInfo SPI_GETWORKAREA, 0, nRect, 0 + GETWORKAREA_WIDTH = (nRect.Right - nRect.Left) +End Function + + diff --git a/src/Pomodoro_Timer.xlsb/CountDown_mac.bas b/src/Pomodoro_Timer.xlsb/CountDown_mac.bas index 5ed66d3..22775be 100644 --- a/src/Pomodoro_Timer.xlsb/CountDown_mac.bas +++ b/src/Pomodoro_Timer.xlsb/CountDown_mac.bas @@ -1,205 +1,205 @@ -Attribute VB_Name = "CountDown_mac" -Option Explicit - -Const FREQ = 1 - -Sub Launch_timer_mac() - 'Stop the code if the form is not visible - If UFIsVisible = False Then: Debug.Print "Form is not visible. The code will now stop.": End - - Dim frm As UserForm - Set frm = PomodoroTimer - Call Optimize_VBA_Performance(True) - - OngoingTimer = True - StopTimer = False - CloseTimer = False - frm.CommandButton2.caption = "Cancel" - - 'Reset the colors - PomodoroTimer.BackColor = -2147483633 - frm.TextBox2.BackColor = -2147483633 - frm.tBx1.BackColor = -2147483633 - - StartTime = Now() - TodaysDate = Date - - - Dim M As Double, S As Double - Dim TotalTime - Dim EndTime As Double - Dim RemaingTime As Double - - TotalTime = 60 * AllowedTime + AllowedTimeSec - EndTime = DateAdd("s", TotalTime, Now()) - RemaingTime = DateDiff("s", Now(), EndTime) - - RemaingTime = DateDiff("s", Now(), EndTime) - M = Int(RemaingTime / 60) - S = RemaingTime - 60 * M - - With frm.tBx1 - .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00") - End With - - 'Released the control to the OS - 'DoEvents - - 'Now "sleep" - Application.OnTime Now + TimeValue("00:00:01") * FREQ, "Launch_timer_mac2" - -End Sub - -Sub Launch_timer_mac2() - Dim frm As UserForm - Set frm = PomodoroTimer - - Dim M As Double, S As Double - Dim TotalTime - Dim EllapsedtTime - Dim StartTime As Double - Dim EndTime As Double - Dim RemaingTime As Double - - TotalTime = 60 * AllowedTime + AllowedTimeSec -' EllapsedtTime = TotalTime - (60 * Split(frm.tBx1.Value, ":")(0) + 1 * Split(frm.tBx1.Value, ":")(1)) -' M = Int(EllapsedtTime / 60) -' S = EllapsedtTime - 60 * M -' EndTime = DateAdd("s", TotalTime, Now()) -' StartTime = Now() - TimeValue("00:" & Format(CStr(M), "00") & ":" & Format(CStr(S), "00")) - RemaingTime = 60 * Split(frm.tBx1.Value, ":")(0) + 1 * Split(frm.tBx1.Value, ":")(1) - - If RemaingTime > 0 And Not StopTimer Then - RemaingTime = RemaingTime - FREQ - M = Int(RemaingTime / 60) - S = RemaingTime - 60 * M - - With frm.tBx1 - .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00") - End With - - 'Released the control to the OS - 'DoEvents - - 'Now "sleep" - Application.OnTime Now + TimeValue("00:00:01") * FREQ, "Launch_timer_mac2" - - Else - - 'Since we are using the "Application.ontime" technique, it is possible that some public variables will have lost their values - If TodaysDate = 0 Then TodaysDate = Date - If StartTime = 0 Then - EllapsedtTime = TotalTime - RemaingTime - M = Int(EllapsedtTime / 60) - S = EllapsedtTime - 60 * M - StartTime = Now() - TimeValue("00:" & Format(CStr(M), "00") & ":" & Format(CStr(S), "00")) - End If - - 'Recording session - If StopTimer = False Or ThisWorkbook.Sheets("Settings").Range("Record_unfinished").Value2 = True Then - If (TotalTime - RemaingTime) / 60 > ThisWorkbook.Sheets("Settings").Range("No_Recording_limit") Then - Call Add_new_record(TodaysDate, StartTime, Now, Not (StopTimer), Range("TaskNameRng")) - End If - End If - - Call Optimize_VBA_Performance(False, xlAutomatic) - - If StopTimer = False Then 'If the timer was stopped by the user - 'Proceed with the Break - If ThisWorkbook.Sheets("Settings").Range("Sound_end_Pomodoro") = True Then Beep - frm.TextBox2.Value = "Break" - Call TakeBreak_mac - Else - 'Do nothing - frm.CommandButton2.caption = "Start" - OngoingTimer = False - End If - - If CloseTimer Then Unload frm - End If -End Sub - -Private Sub TakeBreak_mac() - Dim frm As UserForm - Set frm = PomodoroTimer - 'Reset StopTimer: - StopTimer = False - - Call Optimize_VBA_Performance(True) - - Dim M As Double, S As Double - M = BreakTime - S = BreakTimeSec - - With frm.tBx1 - .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00") - End With - - Call TakeBreak_mac2 - -End Sub - -Private Sub TakeBreak_mac2() - Dim frm As UserForm - Set frm = PomodoroTimer - Dim M As Long, S As Long - Dim EndTime As Double - Dim RemaingTime As Double - Dim TotalTime As Long - - TotalTime = 60 * BreakTime + BreakTimeSec - RemaingTime = 60 * Split(frm.tBx1.Value, ":")(0) + 1 * Split(frm.tBx1.Value, ":")(1) - - If RemaingTime > 0 And Not StopTimer Then - RemaingTime = RemaingTime - FREQ - M = Int(RemaingTime / 60) - S = RemaingTime - 60 * M - - 'Flashing - If TotalTime - RemaingTime < 9 Then - If S Mod 2 = 1 Then - frm.BackColor = GetRGBColor_Fill(Range("Flashing_color")) 'Flashing color - frm.TextBox2.BackColor = GetRGBColor_Fill(Range("Flashing_color")) 'Flashing color - frm.tBx1.BackColor = GetRGBColor_Fill(Range("Flashing_color")) 'Flashing color - Else - frm.BackColor = -2147483633 'Normal color - frm.TextBox2.BackColor = -2147483633 'Normal color - frm.tBx1.BackColor = -2147483633 'Normal color - End If - End If - - With frm.tBx1 - .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00") - End With - 'Released the control to the OS - 'DoEvents - 'Now "sleep" - Application.OnTime Now + TimeValue("00:00:01") * FREQ, "TakeBreak_mac2" - - Else - - If StopTimer = False Then - If ThisWorkbook.Sheets("Settings").Range("Sound_end_Break") = True Then Beep - 'Remain in color to get the user's attention - frm.BackColor = GetRGBColor_Fill(Range("Flashing_color")) 'Flashing color - frm.TextBox2.BackColor = GetRGBColor_Fill(Range("Flashing_color")) 'Flashing color - frm.tBx1.BackColor = GetRGBColor_Fill(Range("Flashing_color")) 'Flashing color - Else - frm.BackColor = -2147483633 'Normal color - frm.TextBox2.BackColor = -2147483633 'Normal color - frm.tBx1.BackColor = -2147483633 'Normal color - End If - frm.TextBox2.Value = "" - frm.CommandButton2.caption = "Start" - OngoingTimer = False - - 'Redo basic calculations form the initialize macro - M = Int(AllowedTime) - S = (AllowedTime - Int(AllowedTime)) * 60 - With frm.tBx1 - .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00") - End With - - Call Optimize_VBA_Performance(False, xlAutomatic) - End If -End Sub +Attribute VB_Name = "CountDown_mac" +Option Explicit + +Const FREQ = 1 + +Sub Launch_timer_mac() + 'Stop the code if the form is not visible + If UFIsVisible = False Then: Debug.Print "Form is not visible. The code will now stop.": End + + Dim frm As UserForm + Set frm = PomodoroTimer + Call Optimize_VBA_Performance(True) + + OngoingTimer = True + StopTimer = False + CloseTimer = False + frm.CommandButton2.caption = "Cancel" + + 'Reset the colors + PomodoroTimer.BackColor = -2147483633 + frm.TextBox2.BackColor = -2147483633 + frm.tBx1.BackColor = -2147483633 + + StartTime = Now() + TodaysDate = Date + + + Dim M As Double, S As Double + Dim TotalTime + Dim EndTime As Double + Dim RemaingTime As Double + + TotalTime = 60 * AllowedTime + AllowedTimeSec + EndTime = DateAdd("s", TotalTime, Now()) + RemaingTime = DateDiff("s", Now(), EndTime) + + RemaingTime = DateDiff("s", Now(), EndTime) + M = Int(RemaingTime / 60) + S = RemaingTime - 60 * M + + With frm.tBx1 + .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00") + End With + + 'Released the control to the OS + 'DoEvents + + 'Now "sleep" + Application.OnTime Now + TimeValue("00:00:01") * FREQ, "Launch_timer_mac2" + +End Sub + +Sub Launch_timer_mac2() + Dim frm As UserForm + Set frm = PomodoroTimer + + Dim M As Double, S As Double + Dim TotalTime + Dim EllapsedtTime + Dim StartTime As Double + Dim EndTime As Double + Dim RemaingTime As Double + + TotalTime = 60 * AllowedTime + AllowedTimeSec +' EllapsedtTime = TotalTime - (60 * Split(frm.tBx1.Value, ":")(0) + 1 * Split(frm.tBx1.Value, ":")(1)) +' M = Int(EllapsedtTime / 60) +' S = EllapsedtTime - 60 * M +' EndTime = DateAdd("s", TotalTime, Now()) +' StartTime = Now() - TimeValue("00:" & Format(CStr(M), "00") & ":" & Format(CStr(S), "00")) + RemaingTime = 60 * Split(frm.tBx1.Value, ":")(0) + 1 * Split(frm.tBx1.Value, ":")(1) + + If RemaingTime > 0 And Not StopTimer Then + RemaingTime = RemaingTime - FREQ + M = Int(RemaingTime / 60) + S = RemaingTime - 60 * M + + With frm.tBx1 + .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00") + End With + + 'Released the control to the OS + 'DoEvents + + 'Now "sleep" + Application.OnTime Now + TimeValue("00:00:01") * FREQ, "Launch_timer_mac2" + + Else + + 'Since we are using the "Application.ontime" technique, it is possible that some public variables will have lost their values + If TodaysDate = 0 Then TodaysDate = Date + If StartTime = 0 Then + EllapsedtTime = TotalTime - RemaingTime + M = Int(EllapsedtTime / 60) + S = EllapsedtTime - 60 * M + StartTime = Now() - TimeValue("00:" & Format(CStr(M), "00") & ":" & Format(CStr(S), "00")) + End If + + 'Recording session + If StopTimer = False Or ThisWorkbook.Sheets("Settings").Range("Record_unfinished").Value2 = True Then + If (TotalTime - RemaingTime) / 60 > ThisWorkbook.Sheets("Settings").Range("No_Recording_limit") Then + Call Add_new_record(TodaysDate, StartTime, Now, Not (StopTimer), Range("TaskNameRng")) + End If + End If + + Call Optimize_VBA_Performance(False, xlAutomatic) + + If StopTimer = False Then 'If the timer was stopped by the user + 'Proceed with the Break + If ThisWorkbook.Sheets("Settings").Range("Sound_end_Pomodoro") = True Then Beep + frm.TextBox2.Value = "Break" + Call TakeBreak_mac + Else + 'Do nothing + frm.CommandButton2.caption = "Start" + OngoingTimer = False + End If + + If CloseTimer Then Unload frm + End If +End Sub + +Private Sub TakeBreak_mac() + Dim frm As UserForm + Set frm = PomodoroTimer + 'Reset StopTimer: + StopTimer = False + + Call Optimize_VBA_Performance(True) + + Dim M As Double, S As Double + M = BreakTime + S = BreakTimeSec + + With frm.tBx1 + .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00") + End With + + Call TakeBreak_mac2 + +End Sub + +Private Sub TakeBreak_mac2() + Dim frm As UserForm + Set frm = PomodoroTimer + Dim M As Long, S As Long + Dim EndTime As Double + Dim RemaingTime As Double + Dim TotalTime As Long + + TotalTime = 60 * BreakTime + BreakTimeSec + RemaingTime = 60 * Split(frm.tBx1.Value, ":")(0) + 1 * Split(frm.tBx1.Value, ":")(1) + + If RemaingTime > 0 And Not StopTimer Then + RemaingTime = RemaingTime - FREQ + M = Int(RemaingTime / 60) + S = RemaingTime - 60 * M + + 'Flashing + If TotalTime - RemaingTime < 9 Then + If S Mod 2 = 1 Then + frm.BackColor = GetRGBColor_Fill(Range("Flashing_color")) 'Flashing color + frm.TextBox2.BackColor = GetRGBColor_Fill(Range("Flashing_color")) 'Flashing color + frm.tBx1.BackColor = GetRGBColor_Fill(Range("Flashing_color")) 'Flashing color + Else + frm.BackColor = -2147483633 'Normal color + frm.TextBox2.BackColor = -2147483633 'Normal color + frm.tBx1.BackColor = -2147483633 'Normal color + End If + End If + + With frm.tBx1 + .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00") + End With + 'Released the control to the OS + 'DoEvents + 'Now "sleep" + Application.OnTime Now + TimeValue("00:00:01") * FREQ, "TakeBreak_mac2" + + Else + + If StopTimer = False Then + If ThisWorkbook.Sheets("Settings").Range("Sound_end_Break") = True Then Beep + 'Remain in color to get the user's attention + frm.BackColor = GetRGBColor_Fill(Range("Flashing_color")) 'Flashing color + frm.TextBox2.BackColor = GetRGBColor_Fill(Range("Flashing_color")) 'Flashing color + frm.tBx1.BackColor = GetRGBColor_Fill(Range("Flashing_color")) 'Flashing color + Else + frm.BackColor = -2147483633 'Normal color + frm.TextBox2.BackColor = -2147483633 'Normal color + frm.tBx1.BackColor = -2147483633 'Normal color + End If + frm.TextBox2.Value = "" + frm.CommandButton2.caption = "Start" + OngoingTimer = False + + 'Redo basic calculations form the initialize macro + M = Int(AllowedTime) + S = (AllowedTime - Int(AllowedTime)) * 60 + With frm.tBx1 + .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00") + End With + + Call Optimize_VBA_Performance(False, xlAutomatic) + End If +End Sub diff --git a/src/Pomodoro_Timer.xlsb/Main.bas b/src/Pomodoro_Timer.xlsb/Main.bas index dc0af8f..39726eb 100644 --- a/src/Pomodoro_Timer.xlsb/Main.bas +++ b/src/Pomodoro_Timer.xlsb/Main.bas @@ -1,42 +1,42 @@ -Attribute VB_Name = "Main" -'Infos: different modes for userform: -'REFERENCE: https://www.mrexcel.com/forum/excel-questions/465425-minimize-excel-leave-userform-showing.html - -Public AllowedTime As Integer 'Number of minutes to count down -Public AllowedTimeSec As Integer 'Number of seconds to count down -Public BreakTime As Double -Public BreakTimeSec As Integer -Public AutoLaunch As Boolean -Public TaskName As String -Public StopTimer As Boolean 'User stopped timer -Public CloseTimer As Boolean 'User clicked the X -Public OngoingTimer As Boolean 'Take the value true after the timer has started (was initialized) -Public StartTime As Variant -Public TodaysDate As Variant -Public UFIsVisible As Boolean - -Sub PomodoroSession() - AllowedTime = Range("Pomodoro") - AllowedTimeSec = Range("Pomodoro_sec") - BreakTime = Range("Break") - BreakTimeSec = Range("Break_sec") - AutoLaunch = True - If Not IsMac Then - If Range("Run_in_seperate_instance").Value = True And Reopen_decision = True Then - Dim Resp As Variant - Resp = MsgBox("To let you work with Excel while the timer is running, this file will now be reopen in a second instance of Excel." & vbNewLine & _ - "Once, the file has been reopened, you will need to relaunch the timer.", vbOKCancel) - If Resp = 1 Then - If ThisWorkbook.Saved = False Then thisworbook.Save - Call OpenItSelfInAnotherInstance - Else 'Cancel or X - Exit Sub - End If - End If - End If - ThisWorkbook.Application.WindowState = xlMinimized - PomodoroTimer.Show vbModeless - 'Note:vbModeless as opposed to vbModal will allow the Excel application to be unlocked while the timer is running -End Sub - - +Attribute VB_Name = "Main" +'Infos: different modes for userform: +'REFERENCE: https://www.mrexcel.com/forum/excel-questions/465425-minimize-excel-leave-userform-showing.html + +Public AllowedTime As Integer 'Number of minutes to count down +Public AllowedTimeSec As Integer 'Number of seconds to count down +Public BreakTime As Double +Public BreakTimeSec As Integer +Public AutoLaunch As Boolean +Public TaskName As String +Public StopTimer As Boolean 'User stopped timer +Public CloseTimer As Boolean 'User clicked the X +Public OngoingTimer As Boolean 'Take the value true after the timer has started (was initialized) +Public StartTime As Variant +Public TodaysDate As Variant +Public UFIsVisible As Boolean + +Sub PomodoroSession() + AllowedTime = Range("Pomodoro") + AllowedTimeSec = Range("Pomodoro_sec") + BreakTime = Range("Break") + BreakTimeSec = Range("Break_sec") + AutoLaunch = True + If Not IsMac Then + If Range("Run_in_seperate_instance").Value = True And Reopen_decision = True Then + Dim Resp As Variant + Resp = MsgBox("To let you work with Excel while the timer is running, this file will now be reopen in a second instance of Excel." & vbNewLine & _ + "Once, the file has been reopened, you will need to relaunch the timer.", vbOKCancel) + If Resp = 1 Then + If ThisWorkbook.Saved = False Then thisworbook.Save + Call OpenItSelfInAnotherInstance + Else 'Cancel or X + Exit Sub + End If + End If + End If + ThisWorkbook.Application.WindowState = xlMinimized + PomodoroTimer.Show vbModeless + 'Note:vbModeless as opposed to vbModal will allow the Excel application to be unlocked while the timer is running +End Sub + + diff --git a/src/Pomodoro_Timer.xlsb/OpenItself.bas b/src/Pomodoro_Timer.xlsb/OpenItself.bas index 5b2fef3..e0c19c4 100644 --- a/src/Pomodoro_Timer.xlsb/OpenItself.bas +++ b/src/Pomodoro_Timer.xlsb/OpenItself.bas @@ -1,185 +1,185 @@ -Attribute VB_Name = "OpenItself" -Option Explicit - -Sub OpenItSelfInAnotherInstance() - Dim objExcel As Excel.Application - Set objExcel = CreateObject("Excel.Application") - Dim FileName As String - - 'If there is no other workbook open in the main instance, we create a new one. - If VisibleWorkbookNB = 1 Then Workbooks.Add - ShowWindow GetForegroundWindow, SW_SHOWMINIMIZED - - - FileName = ThisWorkbook.FullName - - 'Make sure this workbook as its saved status set to true - On Error Resume Next - Dim TestString As String - TestString = CStr(Application.Caller) - If TestString = "Error 2023" Then - ThisWorkbook.Saved = True - Else - ThisWorkbook.Save - End If - On Error GoTo 0 - - 'Need to be in read-only mode before it opening itself in another instance of Excel - On Error GoTo ErrReadOnly - ThisWorkbook.ChangeFileAccess xlReadOnly - On Error GoTo 0 - - On Error GoTo Err1 - Call objExcel.Workbooks.Open(FileName) - On Error GoTo 0 - - objExcel.Visible = True - objExcel.WindowState = xlMaximized - - ThisWorkbook.Close False - - Exit Sub -Err1: - 'This error will occurs when the file was not released for editing quickly enough. - 'In this case, we wait 1 second and try again for a maximum of 5 seconds. - Dim counter As Integer - If counter < 5 Then - Debug.Print "Waiting for the file to be released. Total waiting time: " & counter & " sec" - Sleep (1000) - Else - GoTo Err2 - End If - counter = counter + 1 - - Resume - -Err2: - On Error GoTo 0 - MsgBox "An error occured while trying to open this file in another instance of Excel. " & _ - "This could be due to the fact that the server where you file is stored hasn't release the file properly. " & vbNewLine & _ - "Saving the file on your desktop should resolve this problem." - ShowWindow GetForegroundWindow, SW_MAXIMIZE - ThisWorkbook.Activate - Exit Sub - -ErrReadOnly: - On Error GoTo 0 - MsgBox "An error occured while trying to open this file in another instance of Excel. " & _ - "This could be due to the fact that you are opening the file from a .zip file or a temporary location. " & vbNewLine & _ - "Saving the file on your desktop should resolve this problem." - ShowWindow GetForegroundWindow, SW_MAXIMIZE - ThisWorkbook.Activate - Exit Sub -End Sub - -Public Function Reopen_decision() As Boolean - - -'Is there only one instance of Excel? - Dim OnlyOne As Boolean - If ExcelInstances = 1 Then OnlyOne = True - -'Is it in the first instance - Dim InFirst As Boolean - 'Get handle on the first instance - Dim xlApp As Excel.Application - Set xlApp = GetObject(, "Excel.Application") - - 'Check if a workbook with thisworkbook name is open there. - Dim wb As Workbook - On Error Resume Next - Set wb = xlApp.Application.Workbooks(ThisWorkbook.Name) - On Error GoTo 0 - If Not wb Is Nothing Then - InFirst = True - Else - InFirst = False - End If - -'Is the actual file both in another instance of Excel and the one in the first instance is just a copy? - 'Idea: let's compare the windows handle propertie to make sure they are different. - Dim NotInFirstActually As Boolean - - If InFirst Then - If xlApp.hWnd <> ThisWorkbook.Parent.hWnd Then NotInFirstActually = True - End If -'Is the file alone? - Dim Alone As Boolean - If VisibleWorkbookNB = 1 Then Alone = True - -'Has the file ever been saved? - Dim FileEverSaved As Boolean - If ThisWorkbook.Path <> "" Then - FileEverSaved = True - Else - MsgBox "Warning: To work properly, the file needs to be saves somewhere on your computer.", vbCritical - End If - -'Create choice variable - Dim i(1 To 5) As Integer - 'Convert our booleans into 1s and 0s - i(1) = Abs(OnlyOne) - i(2) = Abs(InFirst) - i(3) = Abs(NotInFirstActually) - i(4) = Abs(Alone) - i(5) = Abs(FileEverSaved) - -Dim choice_vr As String - choice_vr = i(1) & i(2) & i(3) & i(4) & i(5) - 'Now that we have all the relevant information to treat our decision tree, we can proceed - - Dim Decision As Boolean - - Select Case choice_vr 'See the open itself example file to view the decision tree - Case Is = "00000": Decision = 0 - Case Is = "00010": Decision = 0 - Case Is = "00100": Decision = 0 - Case Is = "00110": Decision = 0 - Case Is = "01000": Decision = 0 - Case Is = "01010": Decision = 0 - Case Is = "01100": Decision = 0 - Case Is = "01110": Decision = 0 - Case Is = "10000": Decision = 0 - Case Is = "10010": Decision = 0 - Case Is = "10100": Decision = 0 - Case Is = "10110": Decision = 0 - Case Is = "11000": Decision = 0 - Case Is = "11010": Decision = 0 - Case Is = "11100": Decision = 0 - Case Is = "11110": Decision = 0 - - Case Is = "00001": Decision = 1 - Case Is = "00011": Decision = 0 - Case Is = "00101": Decision = 1 - Case Is = "00111": Decision = 0 - Case Is = "01001": Decision = 1 - Case Is = "01011": Decision = 1 - Case Is = "01101": Decision = 1 - Case Is = "01111": Decision = 0 - Case Is = "10001": Decision = 1 - Case Is = "10011": Decision = 1 - Case Is = "10101": Decision = 1 - Case Is = "10111": Decision = 1 - Case Is = "11001": Decision = 1 - Case Is = "11011": Decision = 1 - Case Is = "11101": Decision = 1 - Case Is = "11111": Decision = 1 - - Case Else: Err.Raise 13 - End Select - - Reopen_decision = Decision - -End Function - - -Function VisibleWorkbookNB() -Dim wb As Workbook, counter As Integer - For Each wb In Excel.Application.Workbooks - If wb.Windows(1).Visible = True Then - counter = counter + 1 - End If - Next wb - - VisibleWorkbookNB = counter -End Function +Attribute VB_Name = "OpenItself" +Option Explicit + +Sub OpenItSelfInAnotherInstance() + Dim objExcel As Excel.Application + Set objExcel = CreateObject("Excel.Application") + Dim FileName As String + + 'If there is no other workbook open in the main instance, we create a new one. + If VisibleWorkbookNB = 1 Then Workbooks.Add + ShowWindow GetForegroundWindow, SW_SHOWMINIMIZED + + + FileName = ThisWorkbook.FullName + + 'Make sure this workbook as its saved status set to true + On Error Resume Next + Dim TestString As String + TestString = CStr(Application.Caller) + If TestString = "Error 2023" Then + ThisWorkbook.Saved = True + Else + ThisWorkbook.Save + End If + On Error GoTo 0 + + 'Need to be in read-only mode before it opening itself in another instance of Excel + On Error GoTo ErrReadOnly + ThisWorkbook.ChangeFileAccess xlReadOnly + On Error GoTo 0 + + On Error GoTo Err1 + Call objExcel.Workbooks.Open(FileName) + On Error GoTo 0 + + objExcel.Visible = True + objExcel.WindowState = xlMaximized + + ThisWorkbook.Close False + + Exit Sub +Err1: + 'This error will occurs when the file was not released for editing quickly enough. + 'In this case, we wait 1 second and try again for a maximum of 5 seconds. + Dim counter As Integer + If counter < 5 Then + Debug.Print "Waiting for the file to be released. Total waiting time: " & counter & " sec" + Sleep (1000) + Else + GoTo Err2 + End If + counter = counter + 1 + + Resume + +Err2: + On Error GoTo 0 + MsgBox "An error occured while trying to open this file in another instance of Excel. " & _ + "This could be due to the fact that the server where you file is stored hasn't release the file properly. " & vbNewLine & _ + "Saving the file on your desktop should resolve this problem." + ShowWindow GetForegroundWindow, SW_MAXIMIZE + ThisWorkbook.Activate + Exit Sub + +ErrReadOnly: + On Error GoTo 0 + MsgBox "An error occured while trying to open this file in another instance of Excel. " & _ + "This could be due to the fact that you are opening the file from a .zip file or a temporary location. " & vbNewLine & _ + "Saving the file on your desktop should resolve this problem." + ShowWindow GetForegroundWindow, SW_MAXIMIZE + ThisWorkbook.Activate + Exit Sub +End Sub + +Public Function Reopen_decision() As Boolean + + +'Is there only one instance of Excel? + Dim OnlyOne As Boolean + If ExcelInstances = 1 Then OnlyOne = True + +'Is it in the first instance + Dim InFirst As Boolean + 'Get handle on the first instance + Dim xlApp As Excel.Application + Set xlApp = GetObject(, "Excel.Application") + + 'Check if a workbook with thisworkbook name is open there. + Dim wb As Workbook + On Error Resume Next + Set wb = xlApp.Application.Workbooks(ThisWorkbook.Name) + On Error GoTo 0 + If Not wb Is Nothing Then + InFirst = True + Else + InFirst = False + End If + +'Is the actual file both in another instance of Excel and the one in the first instance is just a copy? + 'Idea: let's compare the windows handle propertie to make sure they are different. + Dim NotInFirstActually As Boolean + + If InFirst Then + If xlApp.hWnd <> ThisWorkbook.Parent.hWnd Then NotInFirstActually = True + End If +'Is the file alone? + Dim Alone As Boolean + If VisibleWorkbookNB = 1 Then Alone = True + +'Has the file ever been saved? + Dim FileEverSaved As Boolean + If ThisWorkbook.Path <> "" Then + FileEverSaved = True + Else + MsgBox "Warning: To work properly, the file needs to be saves somewhere on your computer.", vbCritical + End If + +'Create choice variable + Dim i(1 To 5) As Integer + 'Convert our booleans into 1s and 0s + i(1) = Abs(OnlyOne) + i(2) = Abs(InFirst) + i(3) = Abs(NotInFirstActually) + i(4) = Abs(Alone) + i(5) = Abs(FileEverSaved) + +Dim choice_vr As String + choice_vr = i(1) & i(2) & i(3) & i(4) & i(5) + 'Now that we have all the relevant information to treat our decision tree, we can proceed + + Dim Decision As Boolean + + Select Case choice_vr 'See the open itself example file to view the decision tree + Case Is = "00000": Decision = 0 + Case Is = "00010": Decision = 0 + Case Is = "00100": Decision = 0 + Case Is = "00110": Decision = 0 + Case Is = "01000": Decision = 0 + Case Is = "01010": Decision = 0 + Case Is = "01100": Decision = 0 + Case Is = "01110": Decision = 0 + Case Is = "10000": Decision = 0 + Case Is = "10010": Decision = 0 + Case Is = "10100": Decision = 0 + Case Is = "10110": Decision = 0 + Case Is = "11000": Decision = 0 + Case Is = "11010": Decision = 0 + Case Is = "11100": Decision = 0 + Case Is = "11110": Decision = 0 + + Case Is = "00001": Decision = 1 + Case Is = "00011": Decision = 0 + Case Is = "00101": Decision = 1 + Case Is = "00111": Decision = 0 + Case Is = "01001": Decision = 1 + Case Is = "01011": Decision = 1 + Case Is = "01101": Decision = 1 + Case Is = "01111": Decision = 0 + Case Is = "10001": Decision = 1 + Case Is = "10011": Decision = 1 + Case Is = "10101": Decision = 1 + Case Is = "10111": Decision = 1 + Case Is = "11001": Decision = 1 + Case Is = "11011": Decision = 1 + Case Is = "11101": Decision = 1 + Case Is = "11111": Decision = 1 + + Case Else: Err.Raise 13 + End Select + + Reopen_decision = Decision + +End Function + + +Function VisibleWorkbookNB() +Dim wb As Workbook, counter As Integer + For Each wb In Excel.Application.Workbooks + If wb.Windows(1).Visible = True Then + counter = counter + 1 + End If + Next wb + + VisibleWorkbookNB = counter +End Function diff --git a/src/Pomodoro_Timer.xlsb/PomodoroTimer.frm b/src/Pomodoro_Timer.xlsb/PomodoroTimer.frm index 8cf6860..4b55957 100644 --- a/src/Pomodoro_Timer.xlsb/PomodoroTimer.frm +++ b/src/Pomodoro_Timer.xlsb/PomodoroTimer.frm @@ -1,298 +1,298 @@ -VERSION 5.00 -Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} PomodoroTimer - Caption = "Timer" - ClientHeight = 924 - ClientLeft = 120 - ClientTop = 468 - ClientWidth = 2196 - OleObjectBlob = "PomodoroTimer.frx":0000 - StartUpPosition = 1 'CenterOwner -End -Attribute VB_Name = "PomodoroTimer" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = True -Attribute VB_Exposed = False - - -'Countdown timer -'REFERENCE: https://www.mrexcel.com/forum/excel-questions/594922-countdown-timer-userform.html - -Option Explicit - -Const sleeptime = 10 'Miliseconds - -Private Sub UserForm_Initialize() - UFIsVisible = True - 'Position of the Userform - If ThisWorkbook.Sheets("Settings").Range("Custom_position") = True And Not IsMac Then - Me.StartUpPosition = 0 - Me.Top = ThisWorkbook.Sheets("Settings").Range("Top_pos").Value2 * (PointPerPixelY() * GETWORKAREA_HEIGHT - Me.Height) - Me.Left = ThisWorkbook.Sheets("Settings").Range("Left_pos").Value2 * (PointPerPixelX() * GETWORKAREA_WIDTH - Me.Width) - ElseIf Not IsMac Then - 'Reposition the window - Me.StartUpPosition = 0 - Me.Top = PointPerPixelY() * GETWORKAREA_HEIGHT - Me.Height - Me.Left = PointPerPixelX() * GETWORKAREA_WIDTH - Me.Width - End If - OngoingTimer = False - - Dim M As Double, S As Double - M = Int(AllowedTime) - S = AllowedTimeSec - - With tBx1 - .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00") - End With - - - 'The code below makes sure that the userform stays on top of all windows. - 'Source: https://www.mrexcel.com/forum/excel-questions/386643-userform-always-top.html - If Not IsMac Then - AlwaysOnTop Me.caption - End If - - If AutoLaunch Then - If IsMac Then - Call Launch_timer_mac - End If - End If - -End Sub -Private Sub UserForm_Activate() - If AutoLaunch Then - If Not IsMac Then - Call Launch_timer - End If - End If -End Sub - -Private Sub Launch_timer() - 'Stop the code if the form is not visible - If UFIsVisible = False Then: Debug.Print "Form is not visible. The code will now stop.": End - - Dim calc_iniset As Variant: calc_iniset = Application.Calculation - Call Optimize_VBA_Performance(True) - - OngoingTimer = True - StopTimer = False - CloseTimer = False - CommandButton2.caption = "Cancel" - - 'Reset the colors - PomodoroTimer.BackColor = -2147483633 - TextBox2.BackColor = -2147483633 - tBx1.BackColor = -2147483633 - - StartTime = Now() - TodaysDate = Date - - - Dim M As Double, S As Double - Dim TotalTime - Dim EndTime As Double - Dim RemaingTime As Double - - TotalTime = 60 * AllowedTime + AllowedTimeSec - EndTime = DateAdd("s", TotalTime, Now()) - RemaingTime = DateDiff("s", Now(), EndTime) - - - Do - RemaingTime = DateDiff("s", Now(), EndTime) - M = Int(RemaingTime / 60) - S = RemaingTime - 60 * M - - With tBx1 - .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00") - End With - - 'Released the control to the OS - DoEvents - - 'Now sleep for 0.1 sec - Call Sleep(sleeptime) - - Loop Until RemaingTime <= 0 Or StopTimer - - 'Recording session - If StopTimer = False Or ThisWorkbook.Sheets("Settings").Range("Record_unfinished").Value2 = True Then - If (TotalTime - RemaingTime) / 60 > ThisWorkbook.Sheets("Settings").Range("No_Recording_limit") Then - Call Add_new_record(TodaysDate, StartTime, Now, Not (StopTimer), ThisWorkbook.Sheets("Pomodoro").Range("TaskNameRng")) - End If - End If - - Call Optimize_VBA_Performance(False, calc_iniset) - - If StopTimer = False Then 'If the timer was stopped by the user - 'Proceed with the Break - If ThisWorkbook.Sheets("Settings").Range("Sound_end_Pomodoro") = True Then Beep - TextBox2.Value = "Break" - Call TakeBreak - Else - 'Do nothing - CommandButton2.caption = "Start" - OngoingTimer = False - End If - - If CloseTimer Then Unload Me - -End Sub - -Private Sub TakeBreak() - 'Reset StopTimer: - StopTimer = False - - Dim calc_iniset As Variant: calc_iniset = Application.Calculation - Call Optimize_VBA_Performance(True) - - Dim M As Double, S As Double - M = BreakTime - S = BreakTimeSec - - With tBx1 - .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00") - End With - - Call Optimize_VBA_Performance(False, calc_iniset) - - Call TakeBreak2 - -End Sub - -Private Sub TakeBreak2() - Dim M As Long, S As Long - Dim EndTime As Double - Dim RemaingTime As Double - Dim TotalTime As Long - - TotalTime = 60 * BreakTime + BreakTimeSec - EndTime = DateAdd("s", TotalTime, Now()) - RemaingTime = DateDiff("s", Now(), EndTime) - - - Do - RemaingTime = DateDiff("s", Now(), EndTime) - M = Int(RemaingTime / 60) - S = RemaingTime - 60 * M - - 'Flashing - If TotalTime - RemaingTime < 9 Then - If S Mod 2 = 1 Then - PomodoroTimer.BackColor = GetRGBColor_Fill(ThisWorkbook.Sheets("Settings").Range("Flashing_color")) 'Flashing color - TextBox2.BackColor = GetRGBColor_Fill(ThisWorkbook.Sheets("Settings").Range("Flashing_color")) 'Flashing color - tBx1.BackColor = GetRGBColor_Fill(ThisWorkbook.Sheets("Settings").Range("Flashing_color")) 'Flashing color - Else - PomodoroTimer.BackColor = -2147483633 'Normal color - TextBox2.BackColor = -2147483633 'Normal color - tBx1.BackColor = -2147483633 'Normal color - End If - End If - - With tBx1 - .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00") - End With - 'Released the control to the OS - DoEvents - 'Now sleep for 0.1 sec - Call Sleep(sleeptime) - Loop Until RemaingTime <= 0 Or StopTimer - - If StopTimer = False Then - If ThisWorkbook.Sheets("Settings").Range("Sound_end_Break") = True Then Beep - 'Remain in color to get the user's attention - PomodoroTimer.BackColor = GetRGBColor_Fill(ThisWorkbook.Sheets("Settings").Range("Flashing_color")) 'Flashing color - TextBox2.BackColor = GetRGBColor_Fill(ThisWorkbook.Sheets("Settings").Range("Flashing_color")) 'Flashing color - tBx1.BackColor = GetRGBColor_Fill(ThisWorkbook.Sheets("Settings").Range("Flashing_color")) 'Flashing color - Else - PomodoroTimer.BackColor = -2147483633 'Normal color - TextBox2.BackColor = -2147483633 'Normal color - tBx1.BackColor = -2147483633 'Normal color - End If - TextBox2.Value = "" - CommandButton2.caption = "Start" - OngoingTimer = False - - 'Redo basic calculations form the initialize macro - M = Int(AllowedTime) - S = (AllowedTime - Int(AllowedTime)) * 60 - With tBx1 - .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00") - End With - - - -End Sub - -Private Sub CommandButton2_Click() -If OngoingTimer = False Then 'Start the timer - UFIsVisible = True 'The form must be visible - ThisWorkbook.Application.WindowState = xlMinimized - CommandButton2.caption = "Cancel" - If Not IsMac Then - Call Launch_timer - Else - Call Launch_timer_mac - End If -Else 'Stop the timer - StopTimer = True - OngoingTimer = False - 'No need to unload the userform here since the main procedure (Launch_timer) will take care of that - 'Unload Me -End If - -End Sub - - -Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) - 'PURPOSE: This procedure will run if the user click on the "X" to close the userform. - Dim Wkb As Workbook - - Set Wkb = ThisWorkbook - StopTimer = True - CloseTimer = True - - 'At this point, since the user clicked on the userform to close it. Excel is the active window, but it might not be on top. - 'Make Excel the active window (optional) - On Error Resume Next - If ThisWorkbook.Sheets("Settings").Range("Reopen_Excel_after_x").Value2 = True And Not IsMac Then - Call AppActivate(Wkb.Application.caption, True) - ShowWindow GetForegroundWindow, SW_SHOWMAXIMIZED - End If - On Error GoTo 0 - -End Sub - - -Private Sub AlwaysOnTop(caption As String) -'PURPOSE: This function allows the userform to remain on top of all windows - Adjusted -'REFERENCE: https://www.mrexcel.com/forum/excel-questions/386643-userform-always-top-2.html - - #If VBA7 Then - Dim hWnd As LongPtr - #Else - Dim hWnd As Long - #End If - Dim lResult As Boolean - - If Val(Application.Version) >= 9 Then - hWnd = FindWindow("ThunderDFrame", caption) - Else - hWnd = FindWindow("ThunderXFrame", caption) - End If - - If hWnd <> 0 Then - - lResult = SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE) - - Else - - MsgBox "AlwaysOnTop: userform with caption '" & caption & "' not found" - - End If - -End Sub - -Private Sub UserForm_Terminate() - UFIsVisible = False -End Sub +VERSION 5.00 +Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} PomodoroTimer + Caption = "Timer" + ClientHeight = 924 + ClientLeft = 120 + ClientTop = 468 + ClientWidth = 2196 + OleObjectBlob = "PomodoroTimer.frx":0000 + StartUpPosition = 1 'CenterOwner +End +Attribute VB_Name = "PomodoroTimer" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False + + +'Countdown timer +'REFERENCE: https://www.mrexcel.com/forum/excel-questions/594922-countdown-timer-userform.html + +Option Explicit + +Const sleeptime = 10 'Miliseconds + +Private Sub UserForm_Initialize() + UFIsVisible = True + 'Position of the Userform + If ThisWorkbook.Sheets("Settings").Range("Custom_position") = True And Not IsMac Then + Me.StartUpPosition = 0 + Me.Top = ThisWorkbook.Sheets("Settings").Range("Top_pos").Value2 * (PointPerPixelY() * GETWORKAREA_HEIGHT - Me.Height) + Me.Left = ThisWorkbook.Sheets("Settings").Range("Left_pos").Value2 * (PointPerPixelX() * GETWORKAREA_WIDTH - Me.Width) + ElseIf Not IsMac Then + 'Reposition the window + Me.StartUpPosition = 0 + Me.Top = PointPerPixelY() * GETWORKAREA_HEIGHT - Me.Height + Me.Left = PointPerPixelX() * GETWORKAREA_WIDTH - Me.Width + End If + OngoingTimer = False + + Dim M As Double, S As Double + M = Int(AllowedTime) + S = AllowedTimeSec + + With tBx1 + .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00") + End With + + + 'The code below makes sure that the userform stays on top of all windows. + 'Source: https://www.mrexcel.com/forum/excel-questions/386643-userform-always-top.html + If Not IsMac Then + AlwaysOnTop Me.caption + End If + + If AutoLaunch Then + If IsMac Then + Call Launch_timer_mac + End If + End If + +End Sub +Private Sub UserForm_Activate() + If AutoLaunch Then + If Not IsMac Then + Call Launch_timer + End If + End If +End Sub + +Private Sub Launch_timer() + 'Stop the code if the form is not visible + If UFIsVisible = False Then: Debug.Print "Form is not visible. The code will now stop.": End + + Dim calc_iniset As Variant: calc_iniset = Application.Calculation + Call Optimize_VBA_Performance(True) + + OngoingTimer = True + StopTimer = False + CloseTimer = False + CommandButton2.caption = "Cancel" + + 'Reset the colors + PomodoroTimer.BackColor = -2147483633 + TextBox2.BackColor = -2147483633 + tBx1.BackColor = -2147483633 + + StartTime = Now() + TodaysDate = Date + + + Dim M As Double, S As Double + Dim TotalTime + Dim EndTime As Double + Dim RemaingTime As Double + + TotalTime = 60 * AllowedTime + AllowedTimeSec + EndTime = DateAdd("s", TotalTime, Now()) + RemaingTime = DateDiff("s", Now(), EndTime) + + + Do + RemaingTime = DateDiff("s", Now(), EndTime) + M = Int(RemaingTime / 60) + S = RemaingTime - 60 * M + + With tBx1 + .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00") + End With + + 'Released the control to the OS + DoEvents + + 'Now sleep for 0.1 sec + Call Sleep(sleeptime) + + Loop Until RemaingTime <= 0 Or StopTimer + + 'Recording session + If StopTimer = False Or ThisWorkbook.Sheets("Settings").Range("Record_unfinished").Value2 = True Then + If (TotalTime - RemaingTime) / 60 > ThisWorkbook.Sheets("Settings").Range("No_Recording_limit") Then + Call Add_new_record(TodaysDate, StartTime, Now, Not (StopTimer), ThisWorkbook.Sheets("Pomodoro").Range("TaskNameRng")) + End If + End If + + Call Optimize_VBA_Performance(False, calc_iniset) + + If StopTimer = False Then 'If the timer was stopped by the user + 'Proceed with the Break + If ThisWorkbook.Sheets("Settings").Range("Sound_end_Pomodoro") = True Then Beep + TextBox2.Value = "Break" + Call TakeBreak + Else + 'Do nothing + CommandButton2.caption = "Start" + OngoingTimer = False + End If + + If CloseTimer Then Unload Me + +End Sub + +Private Sub TakeBreak() + 'Reset StopTimer: + StopTimer = False + + Dim calc_iniset As Variant: calc_iniset = Application.Calculation + Call Optimize_VBA_Performance(True) + + Dim M As Double, S As Double + M = BreakTime + S = BreakTimeSec + + With tBx1 + .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00") + End With + + Call Optimize_VBA_Performance(False, calc_iniset) + + Call TakeBreak2 + +End Sub + +Private Sub TakeBreak2() + Dim M As Long, S As Long + Dim EndTime As Double + Dim RemaingTime As Double + Dim TotalTime As Long + + TotalTime = 60 * BreakTime + BreakTimeSec + EndTime = DateAdd("s", TotalTime, Now()) + RemaingTime = DateDiff("s", Now(), EndTime) + + + Do + RemaingTime = DateDiff("s", Now(), EndTime) + M = Int(RemaingTime / 60) + S = RemaingTime - 60 * M + + 'Flashing + If TotalTime - RemaingTime < 9 Then + If S Mod 2 = 1 Then + PomodoroTimer.BackColor = GetRGBColor_Fill(ThisWorkbook.Sheets("Settings").Range("Flashing_color")) 'Flashing color + TextBox2.BackColor = GetRGBColor_Fill(ThisWorkbook.Sheets("Settings").Range("Flashing_color")) 'Flashing color + tBx1.BackColor = GetRGBColor_Fill(ThisWorkbook.Sheets("Settings").Range("Flashing_color")) 'Flashing color + Else + PomodoroTimer.BackColor = -2147483633 'Normal color + TextBox2.BackColor = -2147483633 'Normal color + tBx1.BackColor = -2147483633 'Normal color + End If + End If + + With tBx1 + .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00") + End With + 'Released the control to the OS + DoEvents + 'Now sleep for 0.1 sec + Call Sleep(sleeptime) + Loop Until RemaingTime <= 0 Or StopTimer + + If StopTimer = False Then + If ThisWorkbook.Sheets("Settings").Range("Sound_end_Break") = True Then Beep + 'Remain in color to get the user's attention + PomodoroTimer.BackColor = GetRGBColor_Fill(ThisWorkbook.Sheets("Settings").Range("Flashing_color")) 'Flashing color + TextBox2.BackColor = GetRGBColor_Fill(ThisWorkbook.Sheets("Settings").Range("Flashing_color")) 'Flashing color + tBx1.BackColor = GetRGBColor_Fill(ThisWorkbook.Sheets("Settings").Range("Flashing_color")) 'Flashing color + Else + PomodoroTimer.BackColor = -2147483633 'Normal color + TextBox2.BackColor = -2147483633 'Normal color + tBx1.BackColor = -2147483633 'Normal color + End If + TextBox2.Value = "" + CommandButton2.caption = "Start" + OngoingTimer = False + + 'Redo basic calculations form the initialize macro + M = Int(AllowedTime) + S = (AllowedTime - Int(AllowedTime)) * 60 + With tBx1 + .Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00") + End With + + + +End Sub + +Private Sub CommandButton2_Click() +If OngoingTimer = False Then 'Start the timer + UFIsVisible = True 'The form must be visible + ThisWorkbook.Application.WindowState = xlMinimized + CommandButton2.caption = "Cancel" + If Not IsMac Then + Call Launch_timer + Else + Call Launch_timer_mac + End If +Else 'Stop the timer + StopTimer = True + OngoingTimer = False + 'No need to unload the userform here since the main procedure (Launch_timer) will take care of that + 'Unload Me +End If + +End Sub + + +Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) + 'PURPOSE: This procedure will run if the user click on the "X" to close the userform. + Dim Wkb As Workbook + + Set Wkb = ThisWorkbook + StopTimer = True + CloseTimer = True + + 'At this point, since the user clicked on the userform to close it. Excel is the active window, but it might not be on top. + 'Make Excel the active window (optional) + On Error Resume Next + If ThisWorkbook.Sheets("Settings").Range("Reopen_Excel_after_x").Value2 = True And Not IsMac Then + Call AppActivate(Wkb.Application.caption, True) + ShowWindow GetForegroundWindow, SW_SHOWMAXIMIZED + End If + On Error GoTo 0 + +End Sub + + +Private Sub AlwaysOnTop(caption As String) +'PURPOSE: This function allows the userform to remain on top of all windows - Adjusted +'REFERENCE: https://www.mrexcel.com/forum/excel-questions/386643-userform-always-top-2.html + + #If VBA7 Then + Dim hWnd As LongPtr + #Else + Dim hWnd As Long + #End If + Dim lResult As Boolean + + If Val(Application.Version) >= 9 Then + hWnd = FindWindow("ThunderDFrame", caption) + Else + hWnd = FindWindow("ThunderXFrame", caption) + End If + + If hWnd <> 0 Then + + lResult = SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE) + + Else + + MsgBox "AlwaysOnTop: userform with caption '" & caption & "' not found" + + End If + +End Sub + +Private Sub UserForm_Terminate() + UFIsVisible = False +End Sub diff --git a/src/Pomodoro_Timer.xlsb/Records.bas b/src/Pomodoro_Timer.xlsb/Records.bas index 2f37f3b..24189f6 100644 --- a/src/Pomodoro_Timer.xlsb/Records.bas +++ b/src/Pomodoro_Timer.xlsb/Records.bas @@ -1,110 +1,110 @@ -Attribute VB_Name = "Records" -Option Explicit - -Sub Clear_all_records() - Dim sht As Worksheet - Set sht = Sheets("Pomodoro") - - 'Ask the user if an ARCHIVED version should be saved - Dim Decision As Boolean, ireply As Variant - ireply = MsgBox(prompt:="Would you like to save your records in an ARCHIVED file.", Buttons:=vbYesNoCancel, Title:="Decision") - - If ireply = vbYes Then - Decision = True - ElseIf ireply = vbNo Then - Decision = False - Else 'They cancelled (VbCancel) - Exit Sub - End If - - If Decision = True Then - Call Achive_records(sht) - End If - - 'Clear the content of the table - Dim topleft As Range, bottomright As Range - Set topleft = sht.Range("A1").End(xlDown).Offset(1, 0) - Set bottomright = sht.Cells.SpecialCells(xlCellTypeLastCell).Offset(10, 0) - - Range(topleft, bottomright).ClearContents - sht.Range("TaskNameRng").ClearContents - -End Sub - -Sub new_record_test() - - Call Add_new_record(Date, Now, Now, True, "TaskName") - -End Sub - -Sub Add_new_record(Pdate, Pstart, Pend, Pcompleted, TaskName) - - Dim sht As Worksheet - Set sht = Sheets("Pomodoro") - - 'Find where to put the new line - Dim rnb As Long - Dim c As Variant - For Each c In Range(sht.Cells(Range("TopLeftCorner").Row + 1, 1), sht.Cells(LastCell_row(sht) + 1, 1)) - If IsEmpty(c) Then - rnb = c.Row - Exit For - End If - Next c - - sht.Cells(rnb, 1).Value2 = Pdate - sht.Cells(rnb, 2).Value2 = Pstart - sht.Cells(rnb, 3).Value2 = Pend - sht.Cells(rnb, 4).Value2 = Pcompleted - sht.Cells(rnb, 5).Value2 = TaskName - - 'Formatting - sht.Cells(rnb, 1).NumberFormat = "yyyy-mm-dd" - sht.Cells(rnb, 2).NumberFormat = "h:mm AM/PM" - sht.Cells(rnb, 3).NumberFormat = "h:mm AM/PM" - sht.Cells(rnb, 4).NumberFormat = "General" - sht.Cells(rnb, 5).NumberFormat = "General" - - Call Add_task(TaskName) - -End Sub - -Sub Add_task(ByVal TaskName As String) - - Dim x As Variant - On Error Resume Next - x = Application.Match(TaskName, Range("Recent_Tasks").Value2, 0) - On Error GoTo 0 - - If IsError(x) Then - Sheets("Recent").Cells(LastCell_row(Sheets("Recent")) + 1, 1).Value2 = TaskName - End If - -End Sub - -Sub Clear_Recent_Tasks() - - Range(Sheets("Recent").Cells(2, 1), Sheets("Recent").Cells(LastCell_row(Sheets("Recent")), 1)).ClearContents - - 'Refill the dummy task names -' Sheets("Recent").Cells(2, 1).Value2 = "Check emails" -' Sheets("Recent").Cells(3, 1).Value2 = "Make phone call" -' Sheets("Recent").Cells(4, 1).Value2 = "Reading" - -End Sub - -Sub Achive_records(ByRef sht As Worksheet) - - sht.Copy - With ActiveWorkbook - .SaveAs FileName:=ThisWorkbook.Path & "\Pomodoro_Timer_ARCHIVE_" & Format(Now, "YYYYMMDD") & ".xlsx", FileFormat:=xlOpenXMLWorkbook - .Close SaveChanges:=False - End With - -End Sub - -Sub Refresh_Summary_PivotTable() - - Sheets("Summary").PivotTables("PivotTable1").PivotCache.Refresh - -End Sub +Attribute VB_Name = "Records" +Option Explicit + +Sub Clear_all_records() + Dim sht As Worksheet + Set sht = Sheets("Pomodoro") + + 'Ask the user if an ARCHIVED version should be saved + Dim Decision As Boolean, ireply As Variant + ireply = MsgBox(prompt:="Would you like to save your records in an ARCHIVED file.", Buttons:=vbYesNoCancel, Title:="Decision") + + If ireply = vbYes Then + Decision = True + ElseIf ireply = vbNo Then + Decision = False + Else 'They cancelled (VbCancel) + Exit Sub + End If + + If Decision = True Then + Call Achive_records(sht) + End If + + 'Clear the content of the table + Dim topleft As Range, bottomright As Range + Set topleft = sht.Range("A1").End(xlDown).Offset(1, 0) + Set bottomright = sht.Cells.SpecialCells(xlCellTypeLastCell).Offset(10, 0) + + Range(topleft, bottomright).ClearContents + sht.Range("TaskNameRng").ClearContents + +End Sub + +Sub new_record_test() + + Call Add_new_record(Date, Now, Now, True, "TaskName") + +End Sub + +Sub Add_new_record(Pdate, Pstart, Pend, Pcompleted, TaskName) + + Dim sht As Worksheet + Set sht = Sheets("Pomodoro") + + 'Find where to put the new line + Dim rnb As Long + Dim c As Variant + For Each c In Range(sht.Cells(Range("TopLeftCorner").Row + 1, 1), sht.Cells(LastCell_row(sht) + 1, 1)) + If IsEmpty(c) Then + rnb = c.Row + Exit For + End If + Next c + + sht.Cells(rnb, 1).Value2 = Pdate + sht.Cells(rnb, 2).Value2 = Pstart + sht.Cells(rnb, 3).Value2 = Pend + sht.Cells(rnb, 4).Value2 = Pcompleted + sht.Cells(rnb, 5).Value2 = TaskName + + 'Formatting + sht.Cells(rnb, 1).NumberFormat = "yyyy-mm-dd" + sht.Cells(rnb, 2).NumberFormat = "h:mm AM/PM" + sht.Cells(rnb, 3).NumberFormat = "h:mm AM/PM" + sht.Cells(rnb, 4).NumberFormat = "General" + sht.Cells(rnb, 5).NumberFormat = "General" + + Call Add_task(TaskName) + +End Sub + +Sub Add_task(ByVal TaskName As String) + + Dim x As Variant + On Error Resume Next + x = Application.Match(TaskName, Range("Recent_Tasks").Value2, 0) + On Error GoTo 0 + + If IsError(x) Then + Sheets("Recent").Cells(LastCell_row(Sheets("Recent")) + 1, 1).Value2 = TaskName + End If + +End Sub + +Sub Clear_Recent_Tasks() + + Range(Sheets("Recent").Cells(2, 1), Sheets("Recent").Cells(LastCell_row(Sheets("Recent")), 1)).ClearContents + + 'Refill the dummy task names +' Sheets("Recent").Cells(2, 1).Value2 = "Check emails" +' Sheets("Recent").Cells(3, 1).Value2 = "Make phone call" +' Sheets("Recent").Cells(4, 1).Value2 = "Reading" + +End Sub + +Sub Achive_records(ByRef sht As Worksheet) + + sht.Copy + With ActiveWorkbook + .SaveAs FileName:=ThisWorkbook.Path & "\Pomodoro_Timer_ARCHIVE_" & Format(Now, "YYYYMMDD") & ".xlsx", FileFormat:=xlOpenXMLWorkbook + .Close SaveChanges:=False + End With + +End Sub + +Sub Refresh_Summary_PivotTable() + + Sheets("Summary").PivotTables("PivotTable1").PivotCache.Refresh + +End Sub diff --git a/src/Pomodoro_Timer.xlsb/ThisWorkbook.sheet.cls b/src/Pomodoro_Timer.xlsb/ThisWorkbook.sheet.cls index 15c68c6..411e323 100644 --- a/src/Pomodoro_Timer.xlsb/ThisWorkbook.sheet.cls +++ b/src/Pomodoro_Timer.xlsb/ThisWorkbook.sheet.cls @@ -1,31 +1,31 @@ -Private Sub Workbook_Open() - If Sheets("Settings").Range("Shortcut").Value = True And Not IsMac Then - Call Shortcuts - End If - Call MacOptions -End Sub - -Sub Shortcuts() - Application.OnKey "{F10}", "PomodoroSession" -End Sub - -Sub MacOptions() -'PURPOSE: Hide options that are not available for Mac - -If IsMac Then - Range("Reopen_Excel_after_x").EntireRow.Hidden = True - Range("Run_in_seperate_instance").EntireRow.Hidden = True - Range("Custom_position").EntireRow.Hidden = True - Range("Left_pos").EntireRow.Hidden = True - Range("Top_pos").EntireRow.Hidden = True - Range("Shortcut").EntireRow.Hidden = True -Else - Range("Reopen_Excel_after_x").EntireRow.Hidden = False - Range("Run_in_seperate_instance").EntireRow.Hidden = False - Range("Custom_position").EntireRow.Hidden = False - Range("Left_pos").EntireRow.Hidden = False - Range("Top_pos").EntireRow.Hidden = False - Range("Shortcut").EntireRow.Hidden = False -End If - +Private Sub Workbook_Open() + If Sheets("Settings").Range("Shortcut").Value = True And Not IsMac Then + Call Shortcuts + End If + Call MacOptions +End Sub + +Sub Shortcuts() + Application.OnKey "{F10}", "PomodoroSession" +End Sub + +Sub MacOptions() +'PURPOSE: Hide options that are not available for Mac + +If IsMac Then + Range("Reopen_Excel_after_x").EntireRow.Hidden = True + Range("Run_in_seperate_instance").EntireRow.Hidden = True + Range("Custom_position").EntireRow.Hidden = True + Range("Left_pos").EntireRow.Hidden = True + Range("Top_pos").EntireRow.Hidden = True + Range("Shortcut").EntireRow.Hidden = True +Else + Range("Reopen_Excel_after_x").EntireRow.Hidden = False + Range("Run_in_seperate_instance").EntireRow.Hidden = False + Range("Custom_position").EntireRow.Hidden = False + Range("Left_pos").EntireRow.Hidden = False + Range("Top_pos").EntireRow.Hidden = False + Range("Shortcut").EntireRow.Hidden = False +End If + End Sub \ No newline at end of file diff --git a/src/Pomodoro_Timer.xlsb/UDF_ExcelIntances.bas b/src/Pomodoro_Timer.xlsb/UDF_ExcelIntances.bas index b418481..b75f355 100644 --- a/src/Pomodoro_Timer.xlsb/UDF_ExcelIntances.bas +++ b/src/Pomodoro_Timer.xlsb/UDF_ExcelIntances.bas @@ -1,52 +1,52 @@ -Attribute VB_Name = "UDF_ExcelIntances" -'PURPOSE: The functions in this module are used to calculate the number of Excel instances currently open - -Option Explicit - - - -Function ExcelInstances() - ExcelInstances = Arr_Countif(AllRunningApps, "EXCEL.EXE") -End Function - -Public Function AllRunningApps() As Variant - 'Reference: http://www.vbaexpress.com/forum/archive/index.php/t-36677.html - Dim strComputer As String - Dim objServices As Object, objProcessSet As Object, Process As Object - Dim oDic As Object, a() As Variant - Dim i As Integer - Set oDic = CreateObject("Scripting.Dictionary") - strComputer = "." - Set objServices = GetObject("winmgmts:\\" _ - & strComputer & "\root\CIMV2") - Set objProcessSet = objServices.ExecQuery _ - ("SELECT Name FROM Win32_Process", , 48) - For Each Process In objProcessSet - i = i + 1 - ReDim Preserve a(1 To i) - a(i) = Process.Name - Next - Set objProcessSet = Nothing - Set oDic = Nothing - AllRunningApps = a() -End Function - -Private Function Arr_Countif(arr, criteria) As Long - Dim i As Long, el As Variant - If TypeName(el) = "string" Then - For Each el In arr - If UCase(el) = UCase(criteria) Then - i = i + 1 - End If - Next el - Else - For Each el In arr - If el = criteria Then - i = i + 1 - End If - Next el - End If - Arr_Countif = i -End Function - - +Attribute VB_Name = "UDF_ExcelIntances" +'PURPOSE: The functions in this module are used to calculate the number of Excel instances currently open + +Option Explicit + + + +Function ExcelInstances() + ExcelInstances = Arr_Countif(AllRunningApps, "EXCEL.EXE") +End Function + +Public Function AllRunningApps() As Variant + 'Reference: http://www.vbaexpress.com/forum/archive/index.php/t-36677.html + Dim strComputer As String + Dim objServices As Object, objProcessSet As Object, Process As Object + Dim oDic As Object, a() As Variant + Dim i As Integer + Set oDic = CreateObject("Scripting.Dictionary") + strComputer = "." + Set objServices = GetObject("winmgmts:\\" _ + & strComputer & "\root\CIMV2") + Set objProcessSet = objServices.ExecQuery _ + ("SELECT Name FROM Win32_Process", , 48) + For Each Process In objProcessSet + i = i + 1 + ReDim Preserve a(1 To i) + a(i) = Process.Name + Next + Set objProcessSet = Nothing + Set oDic = Nothing + AllRunningApps = a() +End Function + +Private Function Arr_Countif(arr, criteria) As Long + Dim i As Long, el As Variant + If TypeName(el) = "string" Then + For Each el In arr + If UCase(el) = UCase(criteria) Then + i = i + 1 + End If + Next el + Else + For Each el In arr + If el = criteria Then + i = i + 1 + End If + Next el + End If + Arr_Countif = i +End Function + + diff --git a/src/Pomodoro_Timer.xlsb/UDF_LastCell.bas b/src/Pomodoro_Timer.xlsb/UDF_LastCell.bas index ae57209..5ed1d0a 100644 --- a/src/Pomodoro_Timer.xlsb/UDF_LastCell.bas +++ b/src/Pomodoro_Timer.xlsb/UDF_LastCell.bas @@ -1,22 +1,22 @@ -Attribute VB_Name = "UDF_LastCell" -Option Explicit - -Function LastCell_row(sht As Worksheet) As Long -'PURPOSE: 'Calculate the last row of data based on column A. - - Dim tst As Range, rownb As Long, oldnb As Long - Set tst = sht.Range("A1") - rownb = tst.Row - Do - oldnb = rownb - Set tst = tst.End(xlDown) - rownb = tst.Row - Loop While rownb > oldnb - -If Not IsEmpty(sht.Cells(rownb, 1)) Then - LastCell_row = rownb -Else - LastCell_row = sht.Cells(rownb, 1).End(xlUp).Row -End If - -End Function +Attribute VB_Name = "UDF_LastCell" +Option Explicit + +Function LastCell_row(sht As Worksheet) As Long +'PURPOSE: 'Calculate the last row of data based on column A. + + Dim tst As Range, rownb As Long, oldnb As Long + Set tst = sht.Range("A1") + rownb = tst.Row + Do + oldnb = rownb + Set tst = tst.End(xlDown) + rownb = tst.Row + Loop While rownb > oldnb + +If Not IsEmpty(sht.Cells(rownb, 1)) Then + LastCell_row = rownb +Else + LastCell_row = sht.Cells(rownb, 1).End(xlUp).Row +End If + +End Function diff --git a/src/Pomodoro_Timer.xlsb/UDF_RGB.bas b/src/Pomodoro_Timer.xlsb/UDF_RGB.bas index 941a212..f4ce9bd 100644 --- a/src/Pomodoro_Timer.xlsb/UDF_RGB.bas +++ b/src/Pomodoro_Timer.xlsb/UDF_RGB.bas @@ -1,19 +1,19 @@ -Attribute VB_Name = "UDF_RGB" -Function GetRGBColor_Fill(ByVal MyCell As Range) As Variant -'PURPOSE: Output the RGB color code from the specified cell -'REFERENCE: www.TheSpreadsheetGuru.com - - Dim temparray(1 To 3) As Variant - Dim HEXcolor As String - Dim RGBcolor As String - - HEXcolor = Right("000000" & Hex(MyCell.Interior.Color), 6) - - temparray(1) = CInt("&H" & Right(HEXcolor, 2)) - temparray(2) = CInt("&H" & Mid(HEXcolor, 3, 2)) - temparray(3) = CInt("&H" & Left(HEXcolor, 2)) - - GetRGBColor_Fill = RGB(temparray(1), temparray(2), temparray(3)) - -End Function - +Attribute VB_Name = "UDF_RGB" +Function GetRGBColor_Fill(ByVal MyCell As Range) As Variant +'PURPOSE: Output the RGB color code from the specified cell +'REFERENCE: www.TheSpreadsheetGuru.com + + Dim temparray(1 To 3) As Variant + Dim HEXcolor As String + Dim RGBcolor As String + + HEXcolor = Right("000000" & Hex(MyCell.Interior.Color), 6) + + temparray(1) = CInt("&H" & Right(HEXcolor, 2)) + temparray(2) = CInt("&H" & Mid(HEXcolor, 3, 2)) + temparray(3) = CInt("&H" & Left(HEXcolor, 2)) + + GetRGBColor_Fill = RGB(temparray(1), temparray(2), temparray(3)) + +End Function + diff --git a/src/Pomodoro_Timer.xlsb/VBA_Optimize.bas b/src/Pomodoro_Timer.xlsb/VBA_Optimize.bas index 8466aa5..0e7bed2 100644 --- a/src/Pomodoro_Timer.xlsb/VBA_Optimize.bas +++ b/src/Pomodoro_Timer.xlsb/VBA_Optimize.bas @@ -1,16 +1,16 @@ -Attribute VB_Name = "VBA_Optimize" -Option Explicit - -Sub Optimize_VBA_Performance(ByVal Optimize As Boolean, Optional Calculation As Variant) -'PURPOSE: Disable some VBA related events to allow the code to run faster -'MORE INFOS: http://analystcave.com/excel-improve-vba-performance/ -'https://support.microsoft.com/fr-fr/help/199505/macro-performance-slow-when-page-breaks-are-visible-in-excel - If IsMissing(Calculation) Then - Calculation = IIf(Optimize, xlCalculationManual, xlCalculationAutomatic) - End If - With Application - .Calculation = Calculation - .ScreenUpdating = Not (Optimize) - .EnableEvents = Not (Optimize) - End With -End Sub +Attribute VB_Name = "VBA_Optimize" +Option Explicit + +Sub Optimize_VBA_Performance(ByVal Optimize As Boolean, Optional Calculation As Variant) +'PURPOSE: Disable some VBA related events to allow the code to run faster +'MORE INFOS: http://analystcave.com/excel-improve-vba-performance/ +'https://support.microsoft.com/fr-fr/help/199505/macro-performance-slow-when-page-breaks-are-visible-in-excel + If IsMissing(Calculation) Then + Calculation = IIf(Optimize, xlCalculationManual, xlCalculationAutomatic) + End If + With Application + .Calculation = Calculation + .ScreenUpdating = Not (Optimize) + .EnableEvents = Not (Optimize) + End With +End Sub diff --git a/src/Pomodoro_Timer.xlsb/Version.bas b/src/Pomodoro_Timer.xlsb/Version.bas index c5a05f6..0bce7c0 100644 --- a/src/Pomodoro_Timer.xlsb/Version.bas +++ b/src/Pomodoro_Timer.xlsb/Version.bas @@ -1,23 +1,23 @@ -Attribute VB_Name = "Version" -Option Explicit -'REFERENCE: https://www.rondebruin.nl/mac/mac001.htm - -Public Function IsMac() As Boolean -#If Mac Then - IsMac = True -#Else - IsMac = False -#End If -End Function - -Public Function Is64BitOffice() As Boolean -#If Win64 Then - Is64BitOffice = True -#End If -End Function - -Public Function Excelversion() As Double -'Win Excel versions are always a whole number (15) -'Mac Excel versions show also the number of the update (15.29) - Excelversion = Val(Application.Version) -End Function +Attribute VB_Name = "Version" +Option Explicit +'REFERENCE: https://www.rondebruin.nl/mac/mac001.htm + +Public Function IsMac() As Boolean +#If Mac Then + IsMac = True +#Else + IsMac = False +#End If +End Function + +Public Function Is64BitOffice() As Boolean +#If Win64 Then + Is64BitOffice = True +#End If +End Function + +Public Function Excelversion() As Double +'Win Excel versions are always a whole number (15) +'Mac Excel versions show also the number of the update (15.29) + Excelversion = Val(Application.Version) +End Function