diff --git a/.gitignore b/.gitignore index 8162564..8b96850 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,5 @@ # Ignore temporary Excel files -*/~$* \ No newline at end of file +*/~$* + +# Ignore scratch work +_scratch \ No newline at end of file diff --git a/Excel-TDD - Blank - Inline.xlsm b/Excel-TDD - Blank - Inline.xlsm index 2818713..26e5092 100644 Binary files a/Excel-TDD - Blank - Inline.xlsm and b/Excel-TDD - Blank - Inline.xlsm differ diff --git a/Excel-TDD - Blank.xlsm b/Excel-TDD - Blank.xlsm index 4ee3d29..a625db1 100644 Binary files a/Excel-TDD - Blank.xlsm and b/Excel-TDD - Blank.xlsm differ diff --git a/build/dev.vbs b/build/dev.vbs index bf8090f..ecd1a6d 100644 --- a/build/dev.vbs +++ b/build/dev.vbs @@ -49,12 +49,35 @@ Specs = Array( _ "SpecExpectationSpecs.bas" _ ) +Dim InlineRunner +InlineRunner = Array( _ + "InlineRunner.bas" _ +) + +Dim DisplayRunner +DisplayRunner = Array( _ + "DisplayRunner.bas" _ +) + +Dim WorkbookExtensions +WorkbookExtensions = Array( _ + "IScenario.cls", _ + "Scenario.cls", _ + "IWBProxy.cls", _ + "WBProxy.cls" _ +) + +Dim Helpers +Helpers = Array( _ + "SpecHelpers.bas" _ +) + Main Sub Main() ' On Error Resume Next - PrintLn "Excel-TDD v1.2.3 Development" + PrintLn "Excel-TDD v1.3.0 Development" ExcelWasOpen = OpenExcel(Excel) @@ -72,8 +95,8 @@ End Sub Sub Development PrintLn vbNewLine & _ "Options:" & vbNewLine & _ - "- import [src/specs/all] to [blank/specs/all/path...]" & vbNewLine & _ - "- export [src/specs/all] from [blank/specs/all/path...]" & vbNewLine & _ + "- import [src/specs/inline/display/extensions/helpers/all] to [blank/inline/display/specs/all/path...]" & vbNewLine & _ + "- export [src/specs/inline/display/extensions/helpers/all] from [blank/inline/display/specs/all/path...]" & vbNewLine & _ "- release" Dim Action @@ -93,7 +116,12 @@ Sub Development If UCase(Parts(0)) = "RELEASE" Then Execute "import", "src", "all" + Execute "import", "inline", "inline" + Execute "import", "display", "display" + Execute "import", "extensions", "display" + Execute "import", "helpers", "specs" Execute "import", "specs", "specs" + Execute "import", "inline", "specs" ElseIf UBound(Parts) < 3 Or (UCase(Parts(0)) <> "IMPORT" And UCase(Parts(0)) <> "EXPORT") Then PrintLn vbNewLine & "Error: Unrecognized action" Else @@ -116,9 +144,8 @@ Sub Development End If End If - If UCase(Left(Input(vbNewLine & "Would you like to do anything else? [yes/no] <"), 1)) = "Y" Then - Development - End If + PrintLn "" + Development End Sub Sub Execute(Name, ModulesDescription, WorkbookDescription) @@ -127,11 +154,15 @@ Sub Execute(Name, ModulesDescription, WorkbookDescription) Dim Paths Select Case UCase(WorkbookDescription) Case "BLANK" + Paths = Array(BlankWorkbookPath, BlankInlineWorkbookPath) + Case "INLINE" + Paths = Array(BlankInlineWorkbookPath) + Case "DISPLAY" Paths = Array(BlankWorkbookPath) Case "SPECS" Paths = Array(SpecsWorkbookPath) Case "ALL" - Path = Array(BlankWorkbookPath, SpecsWorkbookPath) + Paths = Array(BlankWorkbookPath, BlankInlineWorkbookPath, SpecsWorkbookPath) Case Else Paths = Array(WorkbookDescription) End Select @@ -173,6 +204,18 @@ Sub Import(ModulesDescription, Workbook) Case "SRC" Modules = Src Folder = SrcFolder + Case "INLINE" + Modules = InlineRunner + Folder = SrcFolder + Case "DISPLAY" + Modules = DisplayRunner + Folder = SrcFolder + Case "EXTENSIONS" + Modules = WorkbookExtensions + Folder = SrcFolder + Case "HELPERS" + Modules = Helpers + Folder = SrcFolder Case "SPECS" Modules = Specs Folder = SpecsFolder diff --git a/build/export.vbs b/build/export.vbs deleted file mode 100644 index 8fc2eab..0000000 --- a/build/export.vbs +++ /dev/null @@ -1,182 +0,0 @@ -Option Explicit - -Dim Args -Dim WBPath -Dim OutputPath -Dim Excel -Dim Workbook -Dim Modules -Dim ExcelWasOpen -Dim WorkbookWasOpen - -Set Args = Wscript.Arguments -If Args.Length > 0 Then - WBPath = Args(0) - OutputPath = Args(1) -End If - -' Setup modules to export -Modules = Array(_ - "InlineRunner.bas", _ - "DisplayRunner.bas", _ - "SpecHelpers.bas", _ - "SpecDefinition.cls", _ - "SpecExpectation.cls", _ - "SpecSuite.cls", _ - "IWBProxy.cls", _ - "WBProxy.cls", _ - "IScenario.cls", _ - "Scenario.cls"_ -) - -If WBPath <> "" And OutputPath <> "" Then - WScript.Echo "Exporting Excel-TDD from " & WBPath & " to " & OutputPath - - ExcelWasOpen = OpenExcel(Excel) - Excel.Visible = True - Excel.DisplayAlerts = False - - ' Get workbook path relative to root Excel-REST project - WBPath = FullPath(WBPath) - OutputPath = FullPath(OutputPath) - - If Right(OutputPath, 1) <> "\" Then - OutputPath = OutputPath & "\" - End If - - ' Open workbook - WorkbookWasOpen = OpenWorkbook(Excel, WBPath, Workbook) - - Dim i - Dim Module - For i = LBound(Modules) To UBound(Modules) - Set Module = GetModule(Workbook, RemoveExtension(Modules(i))) - - If Not Module Is Nothing Then - Module.Export OutputPath & Modules(i) - End If - Next - - CloseWorkbook Workbook, WorkbookWasOpen - CloseExcel Excel, ExcelWasOpen -End If - - -'' -' Module helpers -' ------------------------------------ ' - -Function RemoveModule(Workbook, Name) - Dim Module - Set Module = GetModule(Workbook, Name) - - If Not Module Is Nothing Then - Workbook.VBProject.VBComponents.Remove Module - End If -End Function - -Function GetModule(Workbook, Name) - Dim Module - Set GetModule = Nothing - - For Each Module In Workbook.VBProject.VBComponents - If Module.Name = Name Then - Set GetModule = Module - Exit Function - End If - Next -End Function - -Sub ImportModule(Workbook, Folder, Filename) - If VarType(Workbook) = vbObject Then - RemoveModule Workbook, RemoveExtension(Filename) - Workbook.VBProject.VBComponents.Import FullPath(Folder & Filename) - End If -End Sub - -Sub ImportModules(Workbook, Folder, Filenames) - Dim i - For i = LBound(Filenames) To UBound(Filenames) - ImportModule Workbook, Folder, Filenames(i) - Next -End Sub - - -'' -' Excel helpers -' ------------------------------------ ' - -Function OpenWorkbook(Excel, Path, ByRef Workbook) - On Error Resume Next - - Set Workbook = Excel.Workbooks(GetFilename(Path)) - - If Workbook Is Nothing Or Err.Number <> 0 Then - Set Workbook = Excel.Workbooks.Open(Path) - OpenWorkbook = False - Else - OpenWorkbook = True - End If - - Err.Clear -End Function - -Function OpenExcel(Excel) - On Error Resume Next - - Set Excel = GetObject(, "Excel.Application") - - If Excel Is Nothing Or Err.Number <> 0 Then - Set Excel = CreateObject("Excel.Application") - OpenExcel = False - Else - OpenExcel = True - End If - - Err.Clear -End Function - -Sub CloseWorkbook(ByRef Workbook, KeepWorkbookOpen) - If Not KeepWorkbookOpen And VarType(Workbook) = vbObject Then - Workbook.Close True - End If - - Set Workbook = Nothing -End Sub - -Sub CloseExcel(ByRef Excel, KeepExcelOpen) - If Not KeepExcelOpen Then - Excel.Quit - End If - - Set Excel = Nothing -End Sub - - -'' -' Filesystem helpers -' ------------------------------------ ' - -Function FullPath(Path) - Dim FSO - Set FSO = CreateObject("Scripting.FileSystemObject") - FullPath = FSO.GetAbsolutePathName(Path) -End Function - -Function GetFilename(Path) - Dim Parts - Parts = Split(Path, "\") - - GetFilename = Parts(UBound(Parts)) -End Function - -Function RemoveExtension(Name) - Dim Parts - Parts = Split(Name, ".") - - If UBound(Parts) > LBound(Parts) Then - ReDim Preserve Parts(UBound(Parts) - 1) - End If - - RemoveExtension = Join(Parts, ".") -End Function diff --git a/build/import.vbs b/build/import.vbs deleted file mode 100644 index abd4921..0000000 --- a/build/import.vbs +++ /dev/null @@ -1,191 +0,0 @@ -Option Explicit - -Dim Args -Dim WorkbookPath -Dim RunnerType -Dim InlineModules -Dim DisplayModules -Dim Excel -Dim Workbook -Dim i, j -Dim KeepExcelOpen -Dim KeepWorkbookOpen - -' Setup workbooks for import -' Optionally, pass workbook for import as argument -Set Args = Wscript.Arguments -If Args.Length > 0 Then - WorkbookPath = Args(0) - RunnerType = Args(1) -Else - WorkbookPath = "" -End If - -' Include all standard Excel-REST modules -DisplayModules = Array("DisplayRunner.bas", "SpecDefinition.cls", "SpecExpectation.cls", "SpecSuite.cls", "SpecHelpers.bas", "IScenario.cls", "Scenario.cls", "IWBProxy.cls", "WBProxy.cls") -InlineModules = Array("InlineRunner.bas", "SpecDefinition.cls", "SpecExpectation.cls", "SpecSuite.cls", "SpecHelpers.bas") - -' Open Excel -KeepExcelOpen = OpenExcel(Excel) -Excel.Visible = True -Excel.DisplayAlerts = False - -If WorkbookPath <> "" Then - KeepWorkbookOpen = OpenWorkbook(Excel, FullPath(WorkbookPath), Workbook) - - Select Case UCase(RunnerType) - Case "DISPLAY" - WScript.Echo "Importing display modules for Excel-TDD into " & WorkbookPath - ImportModules Workbook, ".\src\", DisplayModules - Case Else - WScript.Echo "Importing inline modules for Excel-TDD into " & WorkbookPath - ImportModules Workbook, ".\src\", InlineModules - End Select - - CloseWorkbook Workbook, KeepWorkbookOpen -Else - WScript.Echo "Importing inline modules for Excel-TDD into " & "Excel-TDD - Blank - Inline.xlsm" - KeepWorkbookOpen = OpenWorkbook(Excel, FullPath("Excel-TDD - Blank - Inline.xlsm"), Workbook) - ImportModules Workbook, ".\src\", InlineModules - CloseWorkbook Workbook, KeepWorkbookOpen - - WScript.Echo "Importing display modules for Excel-TDD into " & "Excel-TDD - Blank.xlsm" - KeepWorkbookOpen = OpenWorkbook(Excel, FullPath("Excel-TDD - Blank.xlsm"), Workbook) - ImportModules Workbook, ".\src\", DisplayModules - CloseWorkbook Workbook, KeepWorkbookOpen - - WScript.Echo "Importing inline modules for Excel-TDD into " & "examples\Excel-TDD - Example - Inline.xlsm" - KeepWorkbookOpen = OpenWorkbook(Excel, FullPath("examples\Excel-TDD - Example - Inline.xlsm"), Workbook) - ImportModules Workbook, ".\src\", InlineModules - CloseWorkbook Workbook, KeepWorkbookOpen - - WScript.Echo "Importing display modules for Excel-TDD into " & "examples\Excel-TDD - Example - Runner.xlsm" - KeepWorkbookOpen = OpenWorkbook(Excel, FullPath("examples\Excel-TDD - Example - Runner.xlsm"), Workbook) - ImportModules Workbook, ".\src\", DisplayModules - CloseWorkbook Workbook, KeepWorkbookOpen -End If - -CloseExcel Excel, KeepExcelOpen - -Set Workbook = Nothing -Set Excel = Nothing - - -'' -' Module helpers -' ------------------------------------ ' - -Function RemoveModule(Workbook, Name) - Dim Module - Set Module = GetModule(Workbook, Name) - - If Not Module Is Nothing Then - Workbook.VBProject.VBComponents.Remove Module - End If -End Function - -Function GetModule(Workbook, Name) - Dim Module - Set GetModule = Nothing - - For Each Module In Workbook.VBProject.VBComponents - If Module.Name = Name Then - Set GetModule = Module - Exit Function - End If - Next -End Function - -Sub ImportModule(Workbook, Folder, Filename) - If VarType(Workbook) = vbObject Then - RemoveModule Workbook, RemoveExtension(Filename) - Workbook.VBProject.VBComponents.Import FullPath(Folder & Filename) - End If -End Sub - -Sub ImportModules(Workbook, Folder, Filenames) - Dim i - For i = LBound(Filenames) To UBound(Filenames) - ImportModule Workbook, Folder, Filenames(i) - Next -End Sub - - -'' -' Excel helpers -' ------------------------------------ ' - -Function OpenWorkbook(Excel, Path, ByRef Workbook) - On Error Resume Next - - Set Workbook = Excel.Workbooks(GetFilename(Path)) - - If Workbook Is Nothing Or Err.Number <> 0 Then - Set Workbook = Excel.Workbooks.Open(Path) - OpenWorkbook = False - Else - OpenWorkbook = True - End If - - Err.Clear -End Function - -Function OpenExcel(Excel) - On Error Resume Next - - Set Excel = GetObject(, "Excel.Application") - - If Excel Is Nothing Or Err.Number <> 0 Then - Set Excel = CreateObject("Excel.Application") - OpenExcel = False - Else - OpenExcel = True - End If - - Err.Clear -End Function - -Sub CloseWorkbook(ByRef Workbook, KeepWorkbookOpen) - If Not KeepWorkbookOpen And VarType(Workbook) = vbObject Then - Workbook.Close True - End If - - Set Workbook = Nothing -End Sub - -Sub CloseExcel(ByRef Excel, KeepExcelOpen) - If Not KeepExcelOpen Then - Excel.Quit - End If - - Set Excel = Nothing -End Sub - - -'' -' Filesystem helpers -' ------------------------------------ ' - -Function FullPath(Path) - Dim FSO - Set FSO = CreateObject("Scripting.FileSystemObject") - FullPath = FSO.GetAbsolutePathName(Path) -End Function - -Function GetFilename(Path) - Dim Parts - Parts = Split(Path, "\") - - GetFilename = Parts(UBound(Parts)) -End Function - -Function RemoveExtension(Name) - Dim Parts - Parts = Split(Name, ".") - - If UBound(Parts) > LBound(Parts) Then - ReDim Preserve Parts(UBound(Parts) - 1) - End If - - RemoveExtension = Join(Parts, ".") -End Function diff --git a/specs/Excel-TDD - Specs.xlsm b/specs/Excel-TDD - Specs.xlsm index 662fe3a..f1ebb4a 100644 Binary files a/specs/Excel-TDD - Specs.xlsm and b/specs/Excel-TDD - Specs.xlsm differ diff --git a/src/BlankIWBProxy.cls b/src/BlankIWBProxy.cls index e6e3256..5b86a26 100644 --- a/src/BlankIWBProxy.cls +++ b/src/BlankIWBProxy.cls @@ -8,7 +8,7 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False '' -' BlankIWBProxy v1.2.3 +' BlankIWBProxy v1.3.0 ' (c) Tim Hall - https://github.com/timhall/Excel-TDD ' ' Blank implementation of IWBProxy diff --git a/src/DisplayRunner.bas b/src/DisplayRunner.bas index 6a4d48a..ea79b9c 100644 --- a/src/DisplayRunner.bas +++ b/src/DisplayRunner.bas @@ -1,6 +1,6 @@ Attribute VB_Name = "DisplayRunner" '' -' DisplayRunner v1.2.3 +' DisplayRunner v1.3.0 ' (c) Tim Hall - https://github.com/timhall/Excel-TDD ' ' Runner with sheet output diff --git a/src/IScenario.cls b/src/IScenario.cls index 81442ca..5848ea2 100644 --- a/src/IScenario.cls +++ b/src/IScenario.cls @@ -8,7 +8,7 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True '' -' IScenario v1.2.3 +' IScenario v1.3.0 ' (c) Tim Hall - https://github.com/timhall/Excel-TDD ' ' Interface for creating and running scenarios on workbooks diff --git a/src/IWBProxy.cls b/src/IWBProxy.cls index 1d17463..57307e0 100644 --- a/src/IWBProxy.cls +++ b/src/IWBProxy.cls @@ -8,7 +8,7 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True '' -' IWBProxy v1.2.3 +' IWBProxy v1.3.0 ' (c) Tim Hall - https://github.com/timhall/Excel-TDD ' ' Interface for generic workbook proxies diff --git a/src/InlineRunner.bas b/src/InlineRunner.bas index c1ac22e..0dccb5a 100644 --- a/src/InlineRunner.bas +++ b/src/InlineRunner.bas @@ -1,6 +1,6 @@ Attribute VB_Name = "InlineRunner" '' -' InlineRunner v1.2.3 +' InlineRunner v1.3.0 ' (c) Tim Hall - https://github.com/timhall/Excel-TDD ' ' Runner for outputting results of specs to Immediate window diff --git a/src/Scenario.cls b/src/Scenario.cls index aea6f45..57f84c4 100644 --- a/src/Scenario.cls +++ b/src/Scenario.cls @@ -8,7 +8,7 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True '' -' Scenario v1.2.3 +' Scenario v1.3.0 ' (c) Tim Hall - https://github.com/timhall/Excel-TDD ' ' Generic implementation of scenario diff --git a/src/SpecDefinition.cls b/src/SpecDefinition.cls index 4d68cb0..8b6a2b5 100644 --- a/src/SpecDefinition.cls +++ b/src/SpecDefinition.cls @@ -8,7 +8,7 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True '' -' SpecDefinition v1.2.3 +' SpecDefinition v1.3.0 ' (c) Tim Hall - https://github.com/timhall/Excel-TDD ' ' Provides helpers and acts as workbook proxy diff --git a/src/SpecExpectation.cls b/src/SpecExpectation.cls index 6951171..3e802b9 100644 --- a/src/SpecExpectation.cls +++ b/src/SpecExpectation.cls @@ -8,7 +8,7 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True '' -' SpecExpectation v1.2.3 +' SpecExpectation v1.3.0 ' (c) Tim Hall - https://github.com/timhall/Excel-TDD ' ' Provides various tests that can be performed for a provided value diff --git a/src/SpecHelpers.bas b/src/SpecHelpers.bas index ebc2ff8..db10745 100644 --- a/src/SpecHelpers.bas +++ b/src/SpecHelpers.bas @@ -1,6 +1,6 @@ Attribute VB_Name = "SpecHelpers" '' -' SpecHelpers v1.2.3 +' SpecHelpers v1.3.0 ' (c) Tim Hall - https://github.com/timhall/Excel-TDD ' ' General utilities for specs diff --git a/src/SpecSuite.cls b/src/SpecSuite.cls index bb19806..6e22087 100644 --- a/src/SpecSuite.cls +++ b/src/SpecSuite.cls @@ -8,7 +8,7 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True '' -' SpecSuite v1.2.3 +' SpecSuite v1.3.0 ' (c) Tim Hall - https://github.com/timhall/Excel-TDD ' ' A collection of specs with the workbook that they act on diff --git a/src/WBProxy.cls b/src/WBProxy.cls index 8cb0259..552939d 100644 --- a/src/WBProxy.cls +++ b/src/WBProxy.cls @@ -8,7 +8,7 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True '' -' WBProxy v1.2.3 +' WBProxy v1.3.0 ' (c) Tim Hall - https://github.com/timhall/Excel-TDD ' ' Generic implementation of workbook proxy