diff --git a/Project/.gitignore b/Project/.gitignore new file mode 100644 index 0000000..608a9b8 --- /dev/null +++ b/Project/.gitignore @@ -0,0 +1,2 @@ +*.xlsm +*.xls diff --git a/Project/VBAToolKit.xml b/Project/VBAToolKit.xml index 113b93c..33bf138 100644 --- a/Project/VBAToolKit.xml +++ b/Project/VBAToolKit.xml @@ -228,12 +228,12 @@ Source\ConfProd\vtkConfigurationManager.cls - vtkConfigurationManager10Tester - Source\ConfTest\vtkConfigurationManager10Tester.cls + vtkConfManagerExcel10Tester + Source\ConfTest\vtkConfManagerExcel10Tester.cls - vtkConfigurationManager11Tester - Source\ConfTest\vtkConfigurationManager11Tester.cls + vtkConfManagerExcel11Tester + Source\ConfTest\vtkConfManagerExcel11Tester.cls vtkConfigurationManagers @@ -414,8 +414,8 @@ Source\ConfTest\vtkXMLExportTester.cls - vtkRecreateConfigurationTester - Source\ConfTest\vtkRecreateConfigurationTester.cls + vtkRecreateConfExcelTester + Source\ConfTest\vtkRecreateConfExcelTester.cls vtkRecreateConfigurationForm @@ -443,4 +443,30 @@ Source\ConfProd\vtkReference.cls Source\ConfProd\vtkReference.cls + + vtkConfigurationManagerExcel + Source\ConfProd\vtkConfigurationManagerExcel.cls + Source\ConfProd\vtkConfigurationManagerExcel.cls + Source\ConfProd\vtkConfigurationManagerExcel.cls + + + vtkConfigurationManagerXML + Source\ConfProd\vtkConfigurationManagerXML.cls + Source\ConfProd\vtkConfigurationManagerXML.cls + Source\ConfProd\vtkConfigurationManagerXML.cls + + + vtkConfManagerXML20Tester + Source\ConfTest\vtkConfManagerXML20Tester.cls + + + vtkRecreateConfXMLTester + Source\ConfTest\vtkRecreateConfXMLTester.cls + + + vtkWaitForm + Source\ConfProd\vtkWaitForm.frm + Source\ConfProd\vtkWaitForm.frm + Source\ConfProd\vtkWaitForm.frm + diff --git a/Project/VBAToolKit_DEV.xlsm b/Project/VBAToolKit_DEV.xlsm deleted file mode 100644 index d2e2590..0000000 Binary files a/Project/VBAToolKit_DEV.xlsm and /dev/null differ diff --git a/Source/ConfProd/vtkConfigurationManager.cls b/Source/ConfProd/vtkConfigurationManager.cls index 48f89eb..ee4e1f9 100644 --- a/Source/ConfProd/vtkConfigurationManager.cls +++ b/Source/ConfProd/vtkConfigurationManager.cls @@ -9,27 +9,25 @@ Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit '--------------------------------------------------------------------------------------- -' Module : vtkConfigurationManager +' Interface : vtkConfigurationManager ' Author : Jean-Pierre Imbert -' Date : 25/05/2013 -' Purpose : Manage Configurations and Modules of a VTK Project +' Date : 06/07/2014 +' Purpose : Interface for Configurations, References and Modules management of a VTK Project ' - a Configuration is an Excel file containing Modules ' - for each configuration, a Module can be imported/exported to a specific path relative to the VTK Project directory ' - each configuration is a VBA project included in a specific Excel file whose path is relative to the VTK Project directory +' - for each configuration, the set of VBA references is managed +' - some other parameters are managed for each configration +' NOTE : This interface is adopted by Excel and XML versions of a configuration manager +' - vtkConfigurationManagerExcel and vtkConfigurationManagerXML +' Only the getter methods are concerned by the interface, for now only the Excel version +' contains setter methods for the configuration parameters ' ' Usage: -' - Each instance of Configuration Manager is attached to the DEV Excel Worksheet of a VTK project) +' - Each instance of Configuration Manager is attached to a VTK project) ' - the method vtkConfigurationManagerForProject of module vtkConfigurationManagers give the instance attached to a project, or create it -' - a VTK project is implemented by a main Excel file containing a sheet named "vtkConfigurations" -' - if such a sheet doesn't exist, it is created -' - When initializing an instance, the relative development project workbook must be opened -' - else initialization is not performed ' -' To implement later -' - automatic recognition of the configuration sheet version, and proposal to the user to convert to the last version -' cell $A$1 contains the version identification of the sheet version like "vtkConfigurations v1.0" -' -' Copyright 2013 Skwal-Soft (http://skwalsoft.com) +' Copyright 2014 Skwal-Soft (http://skwalsoft.com) ' ' Licensed under the Apache License, Version 2.0 (the "License"); ' you may not use this file except in compliance with the License. @@ -44,747 +42,64 @@ Option Explicit ' limitations under the License. '--------------------------------------------------------------------------------------- -Private m_projectName As String ' The configuration of a project is attached to the DEV Excel file -Private m_workbook As Workbook -Private m_configurationSheet As Worksheet -Private m_rootPath As String -Private m_refManager As vtkReferenceManager -Private m_devConfiguration As Integer -Private Const sheetName As String = "vtkConfigurations" -Private Const currentVersion As String = "vtkConfigurations v1.1" -Private Const version10 As String = "vtkConfigurations v1.0" -Private m_sheetVersion As String -Private Const nbTitleColumns As Integer = 1 -Private Const nameLine = 1 -Private Const pathLine = 2 -Private Const templateLine = 3 -Private Const projectNameLine = 4 -Private Const commentLine = 5 - -Private Sub Class_Initialize() - m_devConfiguration = -1 -End Sub +' init (avec XMLPath spécifique pour XML, avant d'avoir la gestion centralisée des projets) -Private Sub Class_Terminate() - Set m_configurationSheet = Nothing - Set m_workbook = Nothing - Set m_refManager = Nothing -End Sub - -'--------------------------------------------------------------------------------------- -' Property : projectName as String - Read/Write - Public -' Author : Jean-Pierre Imbert -' Date : 25/05/2013 -' Purpose : name of the project attached to this configuration manager -' - when changed, the configurationWorkSheet private property is seset -' NOTE : This is the Default property -' - "Attribute Value.VB_UserMemId = 0" is added as first line of property Get (in exported Module) -' WARNING : The attribute must be explicitly added after each export, or just before import -'--------------------------------------------------------------------------------------- -' +' rootPath +Public Property Get rootPath() As String +' projectName (uniquement en Get pour la première version avant gestion des projets) Public Property Get projectName() As String - projectName = m_projectName -End Property - -Public Property Let projectName(ByVal sprojectName As String) Attribute projectName.VB_UserMemId = 0 - Dim wbName As String - wbName = vtkProjectForName(sprojectName).workbookDEVName - If m_projectName <> sprojectName And VtkWorkbookIsOpen(wbName) Then - m_projectName = sprojectName - Set m_workbook = Workbooks(wbName) - m_rootPath = "" - setConfigurationSheet ' Reset the configuration sheet when the attached project is changed - End If -End Property - -'--------------------------------------------------------------------------------------- -' Property : workbook as WorkBook - Read Only - Private -' Author : Jean-Pierre Imbert -' Date : 09/08/2013 -' Purpose : return the workbook containing the project -'--------------------------------------------------------------------------------------- -' -Private Property Get Workbook() As Workbook - Set Workbook = m_workbook -End Property - -'--------------------------------------------------------------------------------------- -' Function : defaultProjectNameWithNumber as String - Read Only - Private -' Author : Jean-Pierre Imbert -' Date : 08/06/2014 -' Purpose : return the default projectName of a configuration given its number -'--------------------------------------------------------------------------------------- -' -Private Function defaultProjectNameWithNumber(n As Integer) As String - defaultProjectNameWithNumber = Me.configuration(n) -End Function - -'--------------------------------------------------------------------------------------- -' Function : defaultCommentWithNumber as String - Read Only - Private -' Author : Jean-Pierre Imbert -' Date : 08/06/2014 -' Purpose : return the default comment of a configuration given its number -'--------------------------------------------------------------------------------------- -' -Private Function defaultCommentWithNumber(n As Integer) As String - defaultCommentWithNumber = "Project " & Me.configuration(n) -End Function - -'--------------------------------------------------------------------------------------- -' Function : defaultTemplateWithNumber as String - Read Only - Private -' Author : Jean-Pierre Imbert -' Date : 01/07/2014 -' Purpose : return the default Excel template path of a configuration given its number -'--------------------------------------------------------------------------------------- -' -Private Function defaultTemplateWithNumber(n As Integer) As String - defaultTemplateWithNumber = "" -End Function - -'--------------------------------------------------------------------------------------- -' Property : rootPath as String - Read Only - Public -' Author : Jean-Pierre Imbert -' Date : 09/08/2013 -' Purpose : return the rootPath of the project if the Excel file was already saved -' - or return "" if the rootPath can't be determined -' - the rootPath is cached when identified the first time -'--------------------------------------------------------------------------------------- -' -Public Property Get rootPath() As String - Dim ret As String - If Not m_rootPath Like "" Then - ret = m_rootPath - Else - ret = "" - If Not Workbook Is Nothing Then - ret = Workbook.path - If Not ret Like "" Then - Dim fso As New FileSystemObject - ret = fso.GetParentFolderName(ret) - m_rootPath = ret - End If - End If - End If - rootPath = ret -End Property - -'--------------------------------------------------------------------------------------- -' Function : isConfigurationInitializedForWorkbook -' Author : Jean-Pierre Imbert -' Date : 08/08/2013 -' Purpose : return True if a configuration sheet is already initialized in the workbook -' - the parameter is an Excel Workbook name -' - the Excel Workbook must be opened -' WARNING : the configuration manager must not be initialized with a project name -' because the project name setting implies the configuration sheet initialization -'--------------------------------------------------------------------------------------- -' -Public Function isConfigurationInitializedForWorkbook(ExcelName As String) As Boolean - Dim ws As Worksheet - On Error Resume Next - Set ws = Workbooks(ExcelName).Worksheets(sheetName) - On Error GoTo 0 - isConfigurationInitializedForWorkbook = Not (ws Is Nothing) -End Function - -'--------------------------------------------------------------------------------------- -' Function : nbTitleRows -' Author : Jean-Pierre Imbert -' Date : 08/06/2014 -' Purpose : return the number of Title rows in the configuration sheet depend on its version -' - 2 for v1.0, 4 for 1.1 -'--------------------------------------------------------------------------------------- -' -Private Function nbTitleRows() As Integer - If m_sheetVersion = version10 Then nbTitleRows = 2 - If m_sheetVersion = currentVersion Then nbTitleRows = 5 -End Function - -'--------------------------------------------------------------------------------------- -' Procedure : setConfigurationSheet -' Author : Jean-Pierre Imbert -' Date : 25/05/2013 -' Purpose : set then configurationSheet property -' - Create and initialize the sheet if it doesn't exist in the Project file -'--------------------------------------------------------------------------------------- -' -Private Sub setConfigurationSheet() - Dim ws As Worksheet - On Error Resume Next - Set ws = Workbook.Worksheets(sheetName) - On Error GoTo 0 - If ws Is Nothing Then ' If the Configuration doesn't exist, create one - Set ws = Workbook.Worksheets.Add(Type:=xlWorksheet) - ws.name = sheetName - ' Initialize the configuration sheet - initializeConfigurationSheet ws - End If - ' Verify that the configuration sheet is in last known version - If ws.Range("A1") <> currentVersion Then - If ws.Range("A1") <> version10 Then - ' Code to convert from previous version will be implemented here or in a specific method - Else - m_sheetVersion = version10 - End If - Else - m_sheetVersion = currentVersion - End If - ' Set the initialized worksheet property - Set m_configurationSheet = ws -End Sub - -'--------------------------------------------------------------------------------------- -' Procedure : initializeConfigurationSheet -' Author : Jean-Pierre Imbert -' Date : 25/05/2013 -' Purpose : Initialize a new configuration sheet -'--------------------------------------------------------------------------------------- -' -Private Sub initializeConfigurationSheet(ws As Worksheet) - ws.Range("A1") = currentVersion - ws.Range("A2") = "" - ws.Range("A3") = "Path, template, name and comment" - ws.Range("A4") = "" - ws.Range("A5") = "Module Name" - ws.Range("B1") = vtkProjectForName(projectName).projectName - ws.Range("B2") = vtkProjectForName(projectName).projectStandardRelativePath - ws.Range("C1") = vtkProjectForName(projectName).projectDEVName - ws.Range("C2") = vtkProjectForName(projectName).projectDEVStandardRelativePath - - m_devConfiguration = 2 - - ws.Columns("A:C").ColumnWidth = 22 - ws.Range("A1").Font.Size = 8 - ws.Range("A3").HorizontalAlignment = xlCenter - ws.Range("A5").HorizontalAlignment = xlCenter - ws.Range("A5").Font.Bold = True - ws.Range("B1:C2").HorizontalAlignment = xlCenter - ws.Range("B1:C1").Font.Bold = True -End Sub - -'--------------------------------------------------------------------------------------- -' Procedure : updateConfigurationSheetFormat -' Author : Jean-Pierre Imbert -' Date : 08/06/2014 -' Purpose : Update the configuration sheet to the current version -'--------------------------------------------------------------------------------------- -' -Public Sub updateConfigurationSheetFormat() - Dim ws As Worksheet - - If m_sheetVersion = version10 Then - Set ws = configurationSheet - - ws.Rows("3:5").EntireRow.Insert ' Insert new lines for the new format - - ws.Range("A1") = currentVersion - ws.Range("A2") = "" - ws.Range("A3") = "Path, template, name and comment" - ws.Range("A4") = "" - ws.Range("A5") = "Module Name" - - ws.Range("A2").Font.Bold = False - ws.Range("A3").Font.Bold = False - ws.Range("A3").HorizontalAlignment = xlCenter - ws.Range("A5").HorizontalAlignment = xlCenter - ws.Range("A5").Font.Bold = True - - m_sheetVersion = currentVersion ' Set the sheetVersion for correct behavior after conversion - End If - -End Sub - -'--------------------------------------------------------------------------------------- -' Procedure : configurationSheet as Worksheet - Read only - Public -' Author : Jean-Pierre Imbert -' Date : 25/05/2013 -' Purpose : Return the configuration Sheet - used during tests -'--------------------------------------------------------------------------------------- -' -Public Property Get configurationSheet() As Worksheet - Set configurationSheet = m_configurationSheet End Property -'--------------------------------------------------------------------------------------- -' Property : configurationCount as Integer - Read Only - Public -' Author : Jean-Pierre Imbert -' Date : 25/05/2013 -' Purpose : Get the number of configurations -'--------------------------------------------------------------------------------------- -' +' configurationCount Public Property Get configurationCount() As Integer - ' The number of configurations is the number of used columns minus one - configurationCount = configurationSheet.UsedRange.Columns.Count - 1 -End Property - -'--------------------------------------------------------------------------------------- -' Function : configuration -' Author : Jean-Pierre Imbert -' Date : 25/05/2013 -' Purpose : return the n-th configuration of the project, given n as integer -' - return "" if the configuration is inexistant -'--------------------------------------------------------------------------------------- -' -Public Function configuration(n As Integer) As String - Dim sResult As String - sResult = "" - If n >= 1 And n <= configurationCount Then - sResult = configurationSheet.Cells(1, n + nbTitleColumns) - Else - sResult = "" - End If - configuration = sResult -End Function - -'--------------------------------------------------------------------------------------- -' Procedure : addConfiguration -' Author : Jean-Pierre Imbert -' Date : 28/08/2013 -' Purpose : Add a configuration to the configuration manager -' - optionaly a Path, a projectName and a Comment may be given for the configuration -' - all modules pathes are initialized to Null -' - if the configuration already exists, it is not added -' Return : the number of the added configuration -' - if the configuration already exists, return minus the configuration number -'--------------------------------------------------------------------------------------- -' -Public Function addConfiguration(configuration As String, Optional path As String = "", Optional template As String = "", Optional projectName As String = "", Optional comment As String = "") As Integer - Dim n As Integer - n = getConfigurationNumber(configuration) - If n = 0 Then ' n = 0 means non-existant configuration - n = configurationCount + 1 ' Set configuration number - configurationSheet.Cells(1, n + nbTitleColumns) = configuration ' Write configuration name - configurationSheet.Cells(2, n + nbTitleColumns) = path ' Write configuration path - configurationSheet.Cells(3, n + nbTitleColumns) = template ' Write configuration Excel template path - configurationSheet.Cells(4, n + nbTitleColumns) = projectName ' Write configuration projectName - configurationSheet.Cells(5, n + nbTitleColumns) = comment ' Write configuration Comment - Dim i As Integer - For i = 1 To moduleCount ' For each module - configurationSheet.Cells(i + nbTitleRows, n + nbTitleColumns) = "-" ' Set Default path as not initialized - Next i - addConfiguration = n - Else - addConfiguration = -n - End If -End Function - -'--------------------------------------------------------------------------------------- -' Procedure : configurations -' Author : Jean-Pierre Imbert -' Date : 28/08/2013 -' Purpose : Return a collection of initialized vtkConfiguration objects -'--------------------------------------------------------------------------------------- -' +' configurations Public Function configurations() As Collection - Dim col As New Collection, i As Integer, c As vtkConfiguration - For i = 1 To configurationCount - Set c = New vtkConfiguration - c.init confManager:=Me, confNumber:=i - col.Add Item:=c, Key:=configuration(i) - Next i - Set configurations = col -End Function - -'--------------------------------------------------------------------------------------- -' Procedure : getConfigurationNumber -' Author : Jean-Pierre Imbert -' Date : 26/05/2013 -' Purpose : return the number of a configuration given its name -' - return 0 of the name is inexistant -'--------------------------------------------------------------------------------------- -' +' configuration +Public Function configuration(n As Integer) As String +' getConfigurationNumber Public Function getConfigurationNumber(configuration As String) As Integer - Dim r As Range - On Error Resume Next - Set r = configurationSheet.Rows(1) ' Select first column of the sheet - Set r = r.Offset(0, nbTitleColumns) ' Forget the first column - Set r = r.Find(what:=configuration, SearchOrder:=xlByRows, LookAt:=xlWhole) - On Error GoTo 0 - If r Is Nothing Then - getConfigurationNumber = 0 - Else - getConfigurationNumber = r.Column - nbTitleColumns - End If -End Function - -'--------------------------------------------------------------------------------------- -' Procedure : getConfigurationPathWithNumber -' Author : Jean-Pierre Imbert -' Date : 25/05/2013 -' Purpose : return the n-th relative configuration path of the project, given n as integer -' - return "" if the configuration is inexistant -'--------------------------------------------------------------------------------------- -' +' setConfigurationPath +Public Sub setConfigurationPath(configuration As String, path As String) +' getConfigurationPath +Public Function getConfigurationPath(configuration As String) As String +' getConfigurationPathWithNumber Public Function getConfigurationPathWithNumber(n As Integer) As String - Dim sResult As String - sResult = "" - If n >= 1 And n <= configurationCount Then - sResult = configurationSheet.Cells(pathLine, n + nbTitleColumns) - Else - sResult = "" - End If - getConfigurationPathWithNumber = sResult -End Function - -'--------------------------------------------------------------------------------------- -' Procedure : setConfigurationPathWithNumber -' Author : Jean-Pierre Imbert -' Date : 25/05/2013 -' Purpose : change the n-th relative configuration path of the project, given n as integer -' - does nothing if the configuration is inexistant -'--------------------------------------------------------------------------------------- -' +' setConfigurationPathWithNumber <- (dans vtkConfiguration, ne sont utilisés que pour les tests) Public Sub setConfigurationPathWithNumber(n As Integer, path As String) - If n >= 1 And n <= configurationCount Then - configurationSheet.Cells(pathLine, n + nbTitleColumns) = path - End If -End Sub - -'--------------------------------------------------------------------------------------- -' Function : getConfigurationPath -' Author : Jean-Pierre Imbert -' Date : 26/05/2013 -' Purpose : return the relative path of a configuration given its name -' - return "" of the name is inexistant -'--------------------------------------------------------------------------------------- -' -Public Function getConfigurationPath(configuration As String) As String - getConfigurationPath = getConfigurationPathWithNumber(getConfigurationNumber(configuration)) -End Function - -'--------------------------------------------------------------------------------------- -' Procedure : setConfigurationPath -' Author : Jean-Pierre Imbert -' Date : 26/05/2013 -' Purpose : change the path of a configuration given its name -'--------------------------------------------------------------------------------------- -' -Public Sub setConfigurationPath(configuration As String, path As String) - setConfigurationPathWithNumber n:=getConfigurationNumber(configuration), path:=path -End Sub - -'--------------------------------------------------------------------------------------- -' Procedure : getConfigurationProjectNameWithNumber -' Author : Jean-Pierre Imbert -' Date : 08/06/2014 -' Purpose : return the n-th configuration project name of the project, given n as integer -' - return "" if the configuration is inexistant -' - return the default project name if -' - it is not initialized in the configuration sheet v1.1 -' - the configuration sheet is v1.0, so there is no project name field -'--------------------------------------------------------------------------------------- -' +' getConfigurationProjectNameWithNumber Public Function getConfigurationProjectNameWithNumber(n As Integer) As String - Dim sResult As String - sResult = "" - If n >= 1 And n <= configurationCount Then - If m_sheetVersion = currentVersion Then - sResult = configurationSheet.Cells(projectNameLine, n + nbTitleColumns) - If sResult = "" Then sResult = defaultProjectNameWithNumber(n) - Else - sResult = defaultProjectNameWithNumber(n) - End If - Else - sResult = "" - End If - getConfigurationProjectNameWithNumber = sResult -End Function - -'--------------------------------------------------------------------------------------- -' Procedure : setConfigurationProjectNameWithNumber -' Author : Jean-Pierre Imbert -' Date : 08/06/2014 -' Purpose : change the n-th configuration project name of the project, given n as integer -' - does nothing if the configuration is inexistant -' - does nothing and return an error if the configuration sheet is v1.0 -'--------------------------------------------------------------------------------------- -' +' setConfigurationProjectNameWithNumber <- Public Sub setConfigurationProjectNameWithNumber(n As Integer, projectName As String) - If n >= 1 And n <= configurationCount Then - If m_sheetVersion = currentVersion Then - configurationSheet.Cells(projectNameLine, n + nbTitleColumns) = projectName - Else - Err.Raise VTK_OBSOLETE_CONFIGURATION_SHEET, "vtkConfigurationManager:setConfigurationProjectNameWithNumber", _ - "Impossible to set a configuration projectName with this configuration sheet version (project=" & m_projectName & ", " & m_sheetVersion & ")" - End If - End If -End Sub - -'--------------------------------------------------------------------------------------- -' Procedure : getConfigurationCommentWithNumber -' Author : Jean-Pierre Imbert -' Date : 08/06/2014 -' Purpose : return the n-th configuration comment of the project, given n as integer -' - return "" if the configuration is inexistant -' - return the default comment if -' - it is not initialized in the configuration sheet v1.1 -' - the configuration sheet is v1.0, so there is no comment field -'--------------------------------------------------------------------------------------- -' +' getConfigurationCommentWithNumber Public Function getConfigurationCommentWithNumber(n As Integer) As String - Dim sResult As String - sResult = "" - If n >= 1 And n <= configurationCount Then - If m_sheetVersion = currentVersion Then - sResult = configurationSheet.Cells(commentLine, n + nbTitleColumns) - If sResult = "" Then sResult = defaultCommentWithNumber(n) - Else - sResult = defaultCommentWithNumber(n) - End If - Else - sResult = "" - End If - getConfigurationCommentWithNumber = sResult -End Function - -'--------------------------------------------------------------------------------------- -' Procedure : setConfigurationCommentWithNumber -' Author : Jean-Pierre Imbert -' Date : 08/06/2014 -' Purpose : change the n-th configuration comment of the project, given n as integer -' - does nothing if the configuration is inexistant -' - does nothing and return an error if the configuration sheet is v1.0 -'--------------------------------------------------------------------------------------- -' +' setConfigurationCommentWithNumber <- Public Sub setConfigurationCommentWithNumber(n As Integer, comment As String) - If n >= 1 And n <= configurationCount Then - If m_sheetVersion = currentVersion Then - configurationSheet.Cells(commentLine, n + nbTitleColumns) = comment - Else - Err.Raise VTK_OBSOLETE_CONFIGURATION_SHEET, "vtkConfigurationManager:setConfigurationCommentWithNumber", _ - "Impossible to set a configuration comment with this configuration sheet version (project=" & m_projectName & ", " & m_sheetVersion & ")" - End If - End If -End Sub - -'--------------------------------------------------------------------------------------- -' Procedure : getConfigurationTemplateWithNumber -' Author : Jean-Pierre Imbert -' Date : 01/07/2014 -' Purpose : return the n-th configuration Excel template path of the project, given n as integer -' - return "" if the configuration is inexistant -' - return the default comment if -' - it is not initialized in the configuration sheet v1.1 -' - the configuration sheet is v1.0, so there is no comment field -'--------------------------------------------------------------------------------------- -' +' getConfigurationTemplateWithNumber Public Function getConfigurationTemplateWithNumber(n As Integer) As String - Dim sResult As String - sResult = "" - If n >= 1 And n <= configurationCount Then - If m_sheetVersion = currentVersion Then - sResult = configurationSheet.Cells(templateLine, n + nbTitleColumns) - If sResult = "" Then sResult = defaultTemplateWithNumber(n) - Else - sResult = defaultTemplateWithNumber(n) - End If - Else - sResult = "" - End If - getConfigurationTemplateWithNumber = sResult -End Function - -'--------------------------------------------------------------------------------------- -' Procedure : setConfigurationTemplateWithNumber -' Author : Jean-Pierre Imbert -' Date : 01/07/2014 -' Purpose : change the n-th configuration comment of the project, given n as integer -' - does nothing if the configuration is inexistant -' - does nothing and return an error if the configuration sheet is v1.0 -'--------------------------------------------------------------------------------------- -' +' setConfigurationTemplateWithNumber <- Public Sub setConfigurationTemplateWithNumber(n As Integer, template As String) - If n >= 1 And n <= configurationCount Then - If m_sheetVersion = currentVersion Then - configurationSheet.Cells(templateLine, n + nbTitleColumns) = template - Else - Err.Raise VTK_OBSOLETE_CONFIGURATION_SHEET, "vtkConfigurationManager:setConfigurationTemplateWithNumber", _ - "Impossible to set a configuration template path with this configuration sheet version (project=" & m_projectName & ", " & m_sheetVersion & ")" - End If - End If -End Sub - -'--------------------------------------------------------------------------------------- -' Procedure : getConfigurationReferencesWithNumber -' Author : Jean-Pierre Imbert -' Date : 08/06/2014 -' Purpose : return the n-th configuration references collection of the project, given n as integer -'--------------------------------------------------------------------------------------- -' -Public Function getConfigurationReferencesWithNumber(n As Integer) As Collection - Set getConfigurationReferencesWithNumber = referenceManager.references(n) -End Function +' addConfiguration +Public Function addConfiguration(configuration As String, Optional path As String = "", Optional template As String = "", Optional projectName As String = "", Optional comment As String = "") As Integer +' --> on garde les setters dans l'interface, avec une erreur dans XML -'--------------------------------------------------------------------------------------- -' Property : moduleCount as Integer - Read Only - Public -' Author : Jean-Pierre Imbert -' Date : 25/05/2013 -' Purpose : Get the number of modules -'--------------------------------------------------------------------------------------- -' +' moduleCount Public Property Get moduleCount() As Integer - ' The number of modules is the number of used rows minus two - moduleCount = configurationSheet.UsedRange.Rows.Count - nbTitleRows -End Property - -'--------------------------------------------------------------------------------------- -' Procedure : modules -' Author : Jean-Pierre Imbert -' Date : 28/08/2013 -' Purpose : Return a collection of initialized vtkModule objects -'--------------------------------------------------------------------------------------- -' +' modules Public Function modules() As Collection - Dim col As New Collection, i As Integer, m As vtkModule - For i = 1 To moduleCount - Set m = New vtkModule - m.init confManager:=Me, modNumber:=i - col.Add Item:=m, Key:=module(i) - Next i - Set modules = col -End Function -'--------------------------------------------------------------------------------------- -' Function : module -' Author : Jean-Pierre Imbert -' Date : 26/05/2013 -' Purpose : return the n-th module of the project, given n as integer -' - return "" if the module is inexistant -'--------------------------------------------------------------------------------------- -' +' module Public Function module(n As Integer) As String - Dim sResult As String - sResult = "" - If n >= 1 And n <= moduleCount Then - sResult = configurationSheet.Cells(n + nbTitleRows, 1) - Else - sResult = "" - End If - module = sResult -End Function - -'--------------------------------------------------------------------------------------- -' Procedure : getModuleNumber -' Author : Jean-Pierre Imbert -' Date : 26/05/2013 -' Purpose : return the number of a module given its name -' - return 0 of the name is inexistant -'--------------------------------------------------------------------------------------- -' +' getModuleNumber Public Function getModuleNumber(module As String) As Integer - Dim r As Range - On Error Resume Next - Set r = configurationSheet.Columns(1) ' Select first column of the sheet - Set r = r.Offset(nbTitleRows, 0) ' Forget the two first rows - Set r = r.Find(what:=module, SearchOrder:=xlByColumns, LookAt:=xlWhole) - On Error GoTo 0 - If r Is Nothing Then - getModuleNumber = 0 - Else - getModuleNumber = r.Row - nbTitleRows - End If -End Function - -'--------------------------------------------------------------------------------------- -' Procedure : addModule -' Author : Jean-Pierre Imbert -' Date : 26/05/2013 -' Purpose : Add a new module given its name -' - return the number of the added module -' - if the module is already existant, return minus the number of the existant module -'--------------------------------------------------------------------------------------- -' -Public Function addModule(module As String) As Integer - Dim n As Integer - n = getModuleNumber(module) - If n = 0 Then ' n = 0 means non-existant module - n = moduleCount + 1 ' Set module number - configurationSheet.Cells(n + nbTitleRows, 1) = module ' Write module name - Dim i As Integer - For i = 1 To configurationCount ' For each configuration - configurationSheet.Cells(n + nbTitleRows, i + nbTitleColumns) = "-" ' Set Default path as not initialized - Next i - addModule = n - Else - addModule = -n - End If -End Function - -'--------------------------------------------------------------------------------------- -' Procedure : getModulePathWithNumber -' Author : Jean-Pierre Imbert -' Date : 26/05/2013 -' Purpose : Get a module relative path given its module and configuration numbers -' - return "" if the module or the configuration doesn't exist -' - return "" if the path is not initialized ("-" in the cell of the configuration sheet) -'--------------------------------------------------------------------------------------- -' +' getModulePathWithNumber Public Function getModulePathWithNumber(numModule As Integer, numConfiguration As Integer) As String - Dim sResult As String - If numModule >= 1 And numModule <= moduleCount And numConfiguration >= 1 And numConfiguration <= configurationCount Then - sResult = configurationSheet.Cells(numModule + nbTitleRows, numConfiguration + nbTitleColumns) - If sResult = "-" Then sResult = "" - Else - sResult = "" - End If - getModulePathWithNumber = sResult -End Function - -'--------------------------------------------------------------------------------------- -' Procedure : setModulePathWithNumber -' Author : Jean-Pierre Imbert -' Date : 26/05/2013 -' Purpose : Set a module relative path given its module and configuration numbers -' - if the path given is "", it is replaced by "-" in the configuration sheet cell -'--------------------------------------------------------------------------------------- -' +' setModulePathWithNumber <- (dans vtkModule, non utilisé à part dans les tests) Public Sub setModulePathWithNumber(path As String, numModule As Integer, numConfiguration As Integer) - Dim s As String - If numModule >= 1 And numModule <= moduleCount And numConfiguration >= 1 And numConfiguration <= configurationCount Then - If path = "" Then - s = "-" - Else - s = path - End If - configurationSheet.Cells(numModule + nbTitleRows, numConfiguration + nbTitleColumns) = s - End If -End Sub - -'--------------------------------------------------------------------------------------- -' Procedure : referenceManager, private -' Author : Jean-Pierre Imbert -' Date : 19/06/2014 -' Purpose : Return the reference manager associated with the configuration manager -'--------------------------------------------------------------------------------------- -' -Private Function referenceManager() As vtkReferenceManager - initReferences refs:=Nothing - Set referenceManager = m_refManager -End Function +' addModule +Public Function addModule(module As String) As Integer -'--------------------------------------------------------------------------------------- -' Procedure : references -' Author : Jean-Pierre Imbert -' Date : 19/06/2014 -' Purpose : Return a collection of all vtkReferences objects -'--------------------------------------------------------------------------------------- -' +' references Public Function references() As Collection - Set references = referenceManager.allReferences -End Function - -'--------------------------------------------------------------------------------------- -' Procedure : initReferences -' Author : Jean-Pierre Imbert -' Date : 23/06/2014 -' Purpose : Initialize the references with the collection of vtkReference -'--------------------------------------------------------------------------------------- -' -Public Sub initReferences(refs As Collection) - If m_refManager Is Nothing Then - Set m_refManager = New vtkReferenceManager - m_refManager.init Wb:=Workbook, confCount:=Me.configurationCount, nbTitleColumnsInConfSheet:=nbTitleColumns, devConf:=m_devConfiguration, references:=refs - End If -End Sub - +' getConfigurationReferencesWithNumber +Public Function getConfigurationReferencesWithNumber(n As Integer) As Collection diff --git a/Source/ConfProd/vtkConfigurationManagerExcel.cls b/Source/ConfProd/vtkConfigurationManagerExcel.cls new file mode 100644 index 0000000..bb5a60f --- /dev/null +++ b/Source/ConfProd/vtkConfigurationManagerExcel.cls @@ -0,0 +1,960 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "vtkConfigurationManagerExcel" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit +Implements vtkConfigurationManager +'--------------------------------------------------------------------------------------- +' Module : vtkConfigurationManagerExcel, implements vtkConfigurationManager +' Author : Jean-Pierre Imbert +' Date : 25/05/2013 +' Purpose : Manage Configurations and Modules of a VTK Project +' - a Configuration is an Excel file containing Modules +' - for each configuration, a Module can be imported/exported to a specific path relative to the VTK Project directory +' - each configuration is a VBA project included in a specific Excel file whose path is relative to the VTK Project directory +' +' Usage: +' - Each instance of Configuration Manager is attached to the DEV Excel Worksheet of a VTK project) +' - the method vtkConfigurationManagerForProject of module vtkConfigurationManagers give the instance attached to a project, or create it +' - a VTK project is implemented by a main Excel file containing a sheet named "vtkConfigurations" +' - if such a sheet doesn't exist, it is created +' - When initializing an instance, the relative development project workbook must be opened +' - else initialization is not performed +' +' To implement later +' - automatic recognition of the configuration sheet version, and proposal to the user to convert to the last version +' cell $A$1 contains the version identification of the sheet version like "vtkConfigurations v1.0" +' +' Copyright 2013 Skwal-Soft (http://skwalsoft.com) +' +' Licensed under the Apache License, Version 2.0 (the "License"); +' you may not use this file except in compliance with the License. +' You may obtain a copy of the License at +' +' http://www.apache.org/licenses/LICENSE-2.0 +' +' Unless required by applicable law or agreed to in writing, software +' distributed under the License is distributed on an "AS IS" BASIS, +' WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +' See the License for the specific language governing permissions and +' limitations under the License. +'--------------------------------------------------------------------------------------- + +Private m_projectName As String ' The configuration of a project is attached to the DEV Excel file +Private m_workbook As Workbook +Private m_configurationSheet As Worksheet +Private m_rootPath As String +Private m_refManager As vtkReferenceManager +Private m_devConfiguration As Integer +Private Const sheetName As String = "vtkConfigurations" +Private Const currentVersion As String = "vtkConfigurations v1.1" +Private Const version10 As String = "vtkConfigurations v1.0" +Private m_sheetVersion As String +Private Const nbTitleColumns As Integer = 1 +Private Const nameLine = 1 +Private Const pathLine = 2 +Private Const templateLine = 3 +Private Const projectNameLine = 4 +Private Const commentLine = 5 + +Private Sub Class_Initialize() + m_devConfiguration = -1 +End Sub + +Private Sub Class_Terminate() + Set m_configurationSheet = Nothing + Set m_workbook = Nothing + Set m_refManager = Nothing +End Sub + +'--------------------------------------------------------------------------------------- +' Property : projectName as String - Read/Write - Public +' Author : Jean-Pierre Imbert +' Date : 25/05/2013 +' Purpose : name of the project attached to this configuration manager +' - when changed, the configurationWorkSheet private property is seset +' NOTE : This is the Default property +' - "Attribute Value.VB_UserMemId = 0" is added as first line of property Get (in exported Module) +' WARNING : The attribute must be explicitly added after each export, or just before import +'--------------------------------------------------------------------------------------- +' +Public Property Get projectName() As String + projectName = m_projectName +End Property + +Public Property Get vtkConfigurationManager_projectName() As String + vtkConfigurationManager_projectName = projectName +End Property + +Public Property Let projectName(ByVal sprojectName As String) +Attribute projectName.VB_UserMemId = 0 + Dim wbName As String + wbName = vtkProjectForName(sprojectName).workbookDEVName + If m_projectName <> sprojectName And VtkWorkbookIsOpen(wbName) Then + m_projectName = sprojectName + Set m_workbook = Workbooks(wbName) + m_rootPath = "" + setConfigurationSheet ' Reset the configuration sheet when the attached project is changed + End If +End Property + +'--------------------------------------------------------------------------------------- +' Property : workbook as WorkBook - Read Only - Private +' Author : Jean-Pierre Imbert +' Date : 09/08/2013 +' Purpose : return the workbook containing the project +'--------------------------------------------------------------------------------------- +' +Private Property Get Workbook() As Workbook + Set Workbook = m_workbook +End Property + +'--------------------------------------------------------------------------------------- +' Function : defaultProjectNameWithNumber as String - Read Only - Private +' Author : Jean-Pierre Imbert +' Date : 08/06/2014 +' Purpose : return the default projectName of a configuration given its number +'--------------------------------------------------------------------------------------- +' +Private Function defaultProjectNameWithNumber(n As Integer) As String + defaultProjectNameWithNumber = Me.configuration(n) +End Function + +'--------------------------------------------------------------------------------------- +' Function : defaultCommentWithNumber as String - Read Only - Private +' Author : Jean-Pierre Imbert +' Date : 08/06/2014 +' Purpose : return the default comment of a configuration given its number +'--------------------------------------------------------------------------------------- +' +Private Function defaultCommentWithNumber(n As Integer) As String + defaultCommentWithNumber = "Project " & Me.configuration(n) +End Function + +'--------------------------------------------------------------------------------------- +' Function : defaultTemplateWithNumber as String - Read Only - Private +' Author : Jean-Pierre Imbert +' Date : 01/07/2014 +' Purpose : return the default Excel template path of a configuration given its number +'--------------------------------------------------------------------------------------- +' +Private Function defaultTemplateWithNumber(n As Integer) As String + defaultTemplateWithNumber = "" +End Function + +'--------------------------------------------------------------------------------------- +' Property : rootPath as String - Read Only - Public +' Author : Jean-Pierre Imbert +' Date : 09/08/2013 +' Purpose : return the rootPath of the project if the Excel file was already saved +' - or return "" if the rootPath can't be determined +' - the rootPath is cached when identified the first time +'--------------------------------------------------------------------------------------- +' +Public Property Get rootPath() As String + Dim ret As String + If Not m_rootPath Like "" Then + ret = m_rootPath + Else + ret = "" + If Not Workbook Is Nothing Then + ret = Workbook.path + If Not ret Like "" Then + Dim fso As New FileSystemObject + ret = fso.GetParentFolderName(ret) + m_rootPath = ret + End If + End If + End If + rootPath = ret +End Property + +Public Property Get vtkConfigurationManager_rootPath() As String + vtkConfigurationManager_rootPath = rootPath +End Property + +'--------------------------------------------------------------------------------------- +' Function : isConfigurationInitializedForWorkbook +' Author : Jean-Pierre Imbert +' Date : 08/08/2013 +' Purpose : return True if a configuration sheet is already initialized in the workbook +' - the parameter is an Excel Workbook name +' - the Excel Workbook must be opened +' WARNING : the configuration manager must not be initialized with a project name +' because the project name setting implies the configuration sheet initialization +'--------------------------------------------------------------------------------------- +' +Public Function isConfigurationInitializedForWorkbook(ExcelName As String) As Boolean + Dim ws As Worksheet + On Error Resume Next + Set ws = Workbooks(ExcelName).Worksheets(sheetName) + On Error GoTo 0 + isConfigurationInitializedForWorkbook = Not (ws Is Nothing) +End Function + +'--------------------------------------------------------------------------------------- +' Function : nbTitleRows +' Author : Jean-Pierre Imbert +' Date : 08/06/2014 +' Purpose : return the number of Title rows in the configuration sheet depend on its version +' - 2 for v1.0, 4 for 1.1 +'--------------------------------------------------------------------------------------- +' +Private Function nbTitleRows() As Integer + If m_sheetVersion = version10 Then nbTitleRows = 2 + If m_sheetVersion = currentVersion Then nbTitleRows = 5 +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : setConfigurationSheet +' Author : Jean-Pierre Imbert +' Date : 25/05/2013 +' Purpose : set then configurationSheet property +' - Create and initialize the sheet if it doesn't exist in the Project file +'--------------------------------------------------------------------------------------- +' +Private Sub setConfigurationSheet() + Dim ws As Worksheet + On Error Resume Next + Set ws = Workbook.Worksheets(sheetName) + On Error GoTo 0 + If ws Is Nothing Then ' If the Configuration doesn't exist, create one + Set ws = Workbook.Worksheets.Add(Type:=xlWorksheet) + ws.name = sheetName + ' Initialize the configuration sheet + initializeConfigurationSheet ws + End If + ' Verify that the configuration sheet is in last known version + If ws.Range("A1") <> currentVersion Then + If ws.Range("A1") <> version10 Then + ' Code to convert from previous version will be implemented here or in a specific method + Else + m_sheetVersion = version10 + End If + Else + m_sheetVersion = currentVersion + End If + ' Set the initialized worksheet property + Set m_configurationSheet = ws +End Sub + +'--------------------------------------------------------------------------------------- +' Procedure : initializeConfigurationSheet +' Author : Jean-Pierre Imbert +' Date : 25/05/2013 +' Purpose : Initialize a new configuration sheet +'--------------------------------------------------------------------------------------- +' +Private Sub initializeConfigurationSheet(ws As Worksheet) + ws.Range("A1") = currentVersion + ws.Range("A2") = "" + ws.Range("A3") = "Path, template, name and comment" + ws.Range("A4") = "" + ws.Range("A5") = "Module Name" + ws.Columns("A").ColumnWidth = 22 + ws.Range("A1").Font.Size = 8 + ws.Range("A3").HorizontalAlignment = xlCenter + ws.Range("A5").HorizontalAlignment = xlCenter + ws.Range("A5").Font.Bold = True + If Me.projectName <> "" Then + m_devConfiguration = 2 + ws.Range("B1") = vtkProjectForName(projectName).projectName + ws.Range("B2") = vtkProjectForName(projectName).projectStandardRelativePath + ws.Range("C1") = vtkProjectForName(projectName).projectDEVName + ws.Range("C2") = vtkProjectForName(projectName).projectDEVStandardRelativePath + ws.Range("B1:C2").HorizontalAlignment = xlCenter + ws.Range("B1:C1").Font.Bold = True + ws.Columns("B:C").ColumnWidth = 22 + End If +End Sub + +'--------------------------------------------------------------------------------------- +' Procedure : updateConfigurationSheetFormat +' Author : Jean-Pierre Imbert +' Date : 08/06/2014 +' Purpose : Update the configuration sheet to the current version +'--------------------------------------------------------------------------------------- +' +Public Sub updateConfigurationSheetFormat() + Dim ws As Worksheet + + If m_sheetVersion = version10 Then + Set ws = configurationSheet + + ws.Rows("3:5").EntireRow.Insert ' Insert new lines for the new format + + ws.Range("A1") = currentVersion + ws.Range("A2") = "" + ws.Range("A3") = "Path, template, name and comment" + ws.Range("A4") = "" + ws.Range("A5") = "Module Name" + + ws.Range("A2").Font.Bold = False + ws.Range("A3").Font.Bold = False + ws.Range("A3").HorizontalAlignment = xlCenter + ws.Range("A5").HorizontalAlignment = xlCenter + ws.Range("A5").Font.Bold = True + + m_sheetVersion = currentVersion ' Set the sheetVersion for correct behavior after conversion + End If + +End Sub + +'--------------------------------------------------------------------------------------- +' Procedure : configurationSheet as Worksheet - Read only - Public +' Author : Jean-Pierre Imbert +' Date : 25/05/2013 +' Purpose : Return the configuration Sheet - used during tests +'--------------------------------------------------------------------------------------- +' +Public Property Get configurationSheet() As Worksheet + Set configurationSheet = m_configurationSheet +End Property + +'--------------------------------------------------------------------------------------- +' Property : configurationCount as Integer - Read Only - Public +' Author : Jean-Pierre Imbert +' Date : 25/05/2013 +' Purpose : Get the number of configurations +'--------------------------------------------------------------------------------------- +' +Public Property Get configurationCount() As Integer + ' The number of configurations is the number of used columns minus one + configurationCount = configurationSheet.UsedRange.Columns.Count - 1 +End Property + +Public Property Get vtkConfigurationManager_configurationCount() As Integer + vtkConfigurationManager_configurationCount = configurationCount +End Property + +'--------------------------------------------------------------------------------------- +' Function : configuration +' Author : Jean-Pierre Imbert +' Date : 25/05/2013 +' Purpose : return the n-th configuration of the project, given n as integer +' - return "" if the configuration is inexistant +'--------------------------------------------------------------------------------------- +' +Public Function configuration(n As Integer) As String + Dim sResult As String + sResult = "" + If n >= 1 And n <= configurationCount Then + sResult = configurationSheet.Cells(1, n + nbTitleColumns) + Else + sResult = "" + End If + configuration = sResult +End Function + +Public Function vtkConfigurationManager_configuration(n As Integer) As String + vtkConfigurationManager_configuration = configuration(n) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : addConfiguration +' Author : Jean-Pierre Imbert +' Date : 28/08/2013 +' Purpose : Add a configuration to the configuration manager +' - optionaly a Path, a projectName and a Comment may be given for the configuration +' - all modules pathes are initialized to Null +' - if the configuration already exists, it is not added +' Return : the number of the added configuration +' - if the configuration already exists, return minus the configuration number +'--------------------------------------------------------------------------------------- +' +Public Function addConfiguration(configuration As String, Optional path As String = "", Optional template As String = "", Optional projectName As String = "", Optional comment As String = "") As Integer + Dim n As Integer + n = getConfigurationNumber(configuration) + If n = 0 Then ' n = 0 means non-existant configuration + n = configurationCount + 1 ' Set configuration number + configurationSheet.Cells(1, n + nbTitleColumns) = configuration ' Write configuration name + configurationSheet.Cells(2, n + nbTitleColumns) = path ' Write configuration path + configurationSheet.Cells(3, n + nbTitleColumns) = template ' Write configuration Excel template path + configurationSheet.Cells(4, n + nbTitleColumns) = projectName ' Write configuration projectName + configurationSheet.Cells(5, n + nbTitleColumns) = comment ' Write configuration Comment + Dim i As Integer + For i = 1 To moduleCount ' For each module + configurationSheet.Cells(i + nbTitleRows, n + nbTitleColumns) = "-" ' Set Default path as not initialized + Next i + addConfiguration = n + Else + addConfiguration = -n + End If +End Function + +Public Function vtkConfigurationManager_addConfiguration(configuration As String, Optional path As String = "", Optional template As String = "", Optional projectName As String = "", Optional comment As String = "") As Integer + vtkConfigurationManager_addConfiguration = addConfiguration(configuration, path, template, projectName, comment) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : configurations +' Author : Jean-Pierre Imbert +' Date : 28/08/2013 +' Purpose : Return a collection of initialized vtkConfiguration objects +'--------------------------------------------------------------------------------------- +' +Public Function configurations() As Collection + Dim col As New Collection, i As Integer, c As vtkConfiguration + For i = 1 To configurationCount + Set c = New vtkConfiguration + c.init confManager:=Me, confNumber:=i + col.Add Item:=c, Key:=configuration(i) + Next i + Set configurations = col +End Function + +Public Function vtkConfigurationManager_configurations() As Collection + Set vtkConfigurationManager_configurations = configurations +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : getConfigurationNumber +' Author : Jean-Pierre Imbert +' Date : 26/05/2013 +' Purpose : return the number of a configuration given its name +' - return 0 of the name is inexistant +'--------------------------------------------------------------------------------------- +' +Public Function getConfigurationNumber(configuration As String) As Integer + Dim r As Range + On Error Resume Next + Set r = configurationSheet.Rows(1) ' Select first column of the sheet + Set r = r.Offset(0, nbTitleColumns) ' Forget the first column + Set r = r.Find(what:=configuration, SearchOrder:=xlByRows, LookAt:=xlWhole) + On Error GoTo 0 + If r Is Nothing Then + getConfigurationNumber = 0 + Else + getConfigurationNumber = r.Column - nbTitleColumns + End If +End Function + +Public Function vtkConfigurationManager_getConfigurationNumber(configuration As String) As Integer + vtkConfigurationManager_getConfigurationNumber = getConfigurationNumber(configuration) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : getConfigurationPathWithNumber +' Author : Jean-Pierre Imbert +' Date : 25/05/2013 +' Purpose : return the n-th relative configuration path of the project, given n as integer +' - return "" if the configuration is inexistant +'--------------------------------------------------------------------------------------- +' +Public Function getConfigurationPathWithNumber(n As Integer) As String + Dim sResult As String + sResult = "" + If n >= 1 And n <= configurationCount Then + sResult = configurationSheet.Cells(pathLine, n + nbTitleColumns) + Else + sResult = "" + End If + getConfigurationPathWithNumber = sResult +End Function + +Public Function vtkConfigurationManager_getConfigurationPathWithNumber(n As Integer) As String + vtkConfigurationManager_getConfigurationPathWithNumber = getConfigurationPathWithNumber(n) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : setConfigurationPathWithNumber +' Author : Jean-Pierre Imbert +' Date : 25/05/2013 +' Purpose : change the n-th relative configuration path of the project, given n as integer +' - does nothing if the configuration is inexistant +'--------------------------------------------------------------------------------------- +' +Public Sub setConfigurationPathWithNumber(n As Integer, path As String) + If n >= 1 And n <= configurationCount Then + configurationSheet.Cells(pathLine, n + nbTitleColumns) = path + End If +End Sub + +Public Sub vtkConfigurationManager_setConfigurationPathWithNumber(n As Integer, path As String) + setConfigurationPathWithNumber n, path +End Sub + +'--------------------------------------------------------------------------------------- +' Function : getConfigurationPath +' Author : Jean-Pierre Imbert +' Date : 26/05/2013 +' Purpose : return the relative path of a configuration given its name +' - return "" of the name is inexistant +'--------------------------------------------------------------------------------------- +' +Public Function getConfigurationPath(configuration As String) As String + getConfigurationPath = getConfigurationPathWithNumber(getConfigurationNumber(configuration)) +End Function + +Public Function vtkConfigurationManager_getConfigurationPath(configuration As String) As String + vtkConfigurationManager_getConfigurationPath = getConfigurationPath(configuration) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : setConfigurationPath +' Author : Jean-Pierre Imbert +' Date : 26/05/2013 +' Purpose : change the path of a configuration given its name +'--------------------------------------------------------------------------------------- +' +Public Sub setConfigurationPath(configuration As String, path As String) + setConfigurationPathWithNumber n:=getConfigurationNumber(configuration), path:=path +End Sub + +Public Sub vtkConfigurationManager_setConfigurationPath(configuration As String, path As String) + setConfigurationPath configuration, path +End Sub + +'--------------------------------------------------------------------------------------- +' Procedure : getConfigurationProjectNameWithNumber +' Author : Jean-Pierre Imbert +' Date : 08/06/2014 +' Purpose : return the n-th configuration project name of the project, given n as integer +' - return "" if the configuration is inexistant +' - return the default project name if +' - it is not initialized in the configuration sheet v1.1 +' - the configuration sheet is v1.0, so there is no project name field +'--------------------------------------------------------------------------------------- +' +Public Function getConfigurationProjectNameWithNumber(n As Integer) As String + Dim sResult As String + sResult = "" + If n >= 1 And n <= configurationCount Then + If m_sheetVersion = currentVersion Then + sResult = configurationSheet.Cells(projectNameLine, n + nbTitleColumns) + If sResult = "" Then sResult = defaultProjectNameWithNumber(n) + Else + sResult = defaultProjectNameWithNumber(n) + End If + Else + sResult = "" + End If + getConfigurationProjectNameWithNumber = sResult +End Function + +Public Function vtkConfigurationManager_getConfigurationProjectNameWithNumber(n As Integer) As String + vtkConfigurationManager_getConfigurationProjectNameWithNumber = getConfigurationProjectNameWithNumber(n) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : setConfigurationProjectNameWithNumber +' Author : Jean-Pierre Imbert +' Date : 08/06/2014 +' Purpose : change the n-th configuration project name of the project, given n as integer +' - does nothing if the configuration is inexistant +' - does nothing and return an error if the configuration sheet is v1.0 +'--------------------------------------------------------------------------------------- +' +Public Sub setConfigurationProjectNameWithNumber(n As Integer, projectName As String) + If n >= 1 And n <= configurationCount Then + If m_sheetVersion = currentVersion Then + configurationSheet.Cells(projectNameLine, n + nbTitleColumns) = projectName + Else + Err.Raise VTK_OBSOLETE_CONFIGURATION_SHEET, "vtkConfigurationManagerExcel:setConfigurationProjectNameWithNumber", _ + "Impossible to set a configuration projectName with this configuration sheet version (project=" & m_projectName & ", " & m_sheetVersion & ")" + End If + End If +End Sub + +Public Sub vtkConfigurationManager_setConfigurationProjectNameWithNumber(n As Integer, projectName As String) + setConfigurationProjectNameWithNumber n, projectName +End Sub + +'--------------------------------------------------------------------------------------- +' Procedure : getConfigurationCommentWithNumber +' Author : Jean-Pierre Imbert +' Date : 08/06/2014 +' Purpose : return the n-th configuration comment of the project, given n as integer +' - return "" if the configuration is inexistant +' - return the default comment if +' - it is not initialized in the configuration sheet v1.1 +' - the configuration sheet is v1.0, so there is no comment field +'--------------------------------------------------------------------------------------- +' +Public Function getConfigurationCommentWithNumber(n As Integer) As String + Dim sResult As String + sResult = "" + If n >= 1 And n <= configurationCount Then + If m_sheetVersion = currentVersion Then + sResult = configurationSheet.Cells(commentLine, n + nbTitleColumns) + If sResult = "" Then sResult = defaultCommentWithNumber(n) + Else + sResult = defaultCommentWithNumber(n) + End If + Else + sResult = "" + End If + getConfigurationCommentWithNumber = sResult +End Function + +Public Function vtkConfigurationManager_getConfigurationCommentWithNumber(n As Integer) As String + vtkConfigurationManager_getConfigurationCommentWithNumber = getConfigurationCommentWithNumber(n) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : setConfigurationCommentWithNumber +' Author : Jean-Pierre Imbert +' Date : 08/06/2014 +' Purpose : change the n-th configuration comment of the project, given n as integer +' - does nothing if the configuration is inexistant +' - does nothing and return an error if the configuration sheet is v1.0 +'--------------------------------------------------------------------------------------- +' +Public Sub setConfigurationCommentWithNumber(n As Integer, comment As String) + If n >= 1 And n <= configurationCount Then + If m_sheetVersion = currentVersion Then + configurationSheet.Cells(commentLine, n + nbTitleColumns) = comment + Else + Err.Raise VTK_OBSOLETE_CONFIGURATION_SHEET, "vtkConfigurationManagerExcel:setConfigurationCommentWithNumber", _ + "Impossible to set a configuration comment with this configuration sheet version (project=" & m_projectName & ", " & m_sheetVersion & ")" + End If + End If +End Sub + +Public Sub vtkConfigurationManager_setConfigurationCommentWithNumber(n As Integer, comment As String) + setConfigurationCommentWithNumber n, comment +End Sub + +'--------------------------------------------------------------------------------------- +' Procedure : getConfigurationTemplateWithNumber +' Author : Jean-Pierre Imbert +' Date : 01/07/2014 +' Purpose : return the n-th configuration Excel template path of the project, given n as integer +' - return "" if the configuration is inexistant +' - return the default comment if +' - it is not initialized in the configuration sheet v1.1 +' - the configuration sheet is v1.0, so there is no comment field +'--------------------------------------------------------------------------------------- +' +Public Function getConfigurationTemplateWithNumber(n As Integer) As String + Dim sResult As String + sResult = "" + If n >= 1 And n <= configurationCount Then + If m_sheetVersion = currentVersion Then + sResult = configurationSheet.Cells(templateLine, n + nbTitleColumns) + If sResult = "" Then sResult = defaultTemplateWithNumber(n) + Else + sResult = defaultTemplateWithNumber(n) + End If + Else + sResult = "" + End If + getConfigurationTemplateWithNumber = sResult +End Function + +Public Function vtkConfigurationManager_getConfigurationTemplateWithNumber(n As Integer) As String + vtkConfigurationManager_getConfigurationTemplateWithNumber = getConfigurationTemplateWithNumber(n) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : setConfigurationTemplateWithNumber +' Author : Jean-Pierre Imbert +' Date : 01/07/2014 +' Purpose : change the n-th configuration comment of the project, given n as integer +' - does nothing if the configuration is inexistant +' - does nothing and return an error if the configuration sheet is v1.0 +'--------------------------------------------------------------------------------------- +' +Public Sub setConfigurationTemplateWithNumber(n As Integer, template As String) + If n >= 1 And n <= configurationCount Then + If m_sheetVersion = currentVersion Then + configurationSheet.Cells(templateLine, n + nbTitleColumns) = template + Else + Err.Raise VTK_OBSOLETE_CONFIGURATION_SHEET, "vtkConfigurationManagerExcel:setConfigurationTemplateWithNumber", _ + "Impossible to set a configuration template path with this configuration sheet version (project=" & m_projectName & ", " & m_sheetVersion & ")" + End If + End If +End Sub + +Public Sub vtkConfigurationManager_setConfigurationTemplateWithNumber(n As Integer, template As String) + setConfigurationTemplateWithNumber n, template +End Sub + +'--------------------------------------------------------------------------------------- +' Procedure : getConfigurationReferencesWithNumber +' Author : Jean-Pierre Imbert +' Date : 08/06/2014 +' Purpose : return the n-th configuration references collection of the project, given n as integer +'--------------------------------------------------------------------------------------- +' +Public Function getConfigurationReferencesWithNumber(n As Integer) As Collection + Set getConfigurationReferencesWithNumber = referenceManager.references(n) +End Function + +Public Function vtkConfigurationManager_getConfigurationReferencesWithNumber(n As Integer) As Collection + Set vtkConfigurationManager_getConfigurationReferencesWithNumber = getConfigurationReferencesWithNumber(n) +End Function + +'--------------------------------------------------------------------------------------- +' Property : moduleCount as Integer - Read Only - Public +' Author : Jean-Pierre Imbert +' Date : 25/05/2013 +' Purpose : Get the number of modules +'--------------------------------------------------------------------------------------- +' +Public Property Get moduleCount() As Integer + ' The number of modules is the number of used rows minus two + moduleCount = configurationSheet.UsedRange.Rows.Count - nbTitleRows +End Property + +Public Property Get vtkConfigurationManager_moduleCount() As Integer + vtkConfigurationManager_moduleCount = moduleCount() +End Property + +'--------------------------------------------------------------------------------------- +' Procedure : modules +' Author : Jean-Pierre Imbert +' Date : 28/08/2013 +' Purpose : Return a collection of initialized vtkModule objects +'--------------------------------------------------------------------------------------- +' +Public Function modules() As Collection + Dim col As New Collection, i As Integer, m As vtkModule + For i = 1 To moduleCount + Set m = New vtkModule + m.init confManager:=Me, modNumber:=i + col.Add Item:=m, Key:=module(i) + Next i + Set modules = col +End Function + +Public Function vtkConfigurationManager_modules() As Collection + Set vtkConfigurationManager_modules = modules +End Function + +'--------------------------------------------------------------------------------------- +' Function : module +' Author : Jean-Pierre Imbert +' Date : 26/05/2013 +' Purpose : return the n-th module of the project, given n as integer +' - return "" if the module is inexistant +'--------------------------------------------------------------------------------------- +' +Public Function module(n As Integer) As String + Dim sResult As String + sResult = "" + If n >= 1 And n <= moduleCount Then + sResult = configurationSheet.Cells(n + nbTitleRows, 1) + Else + sResult = "" + End If + module = sResult +End Function + +Public Function vtkConfigurationManager_module(n As Integer) As String + vtkConfigurationManager_module = module(n) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : getModuleNumber +' Author : Jean-Pierre Imbert +' Date : 26/05/2013 +' Purpose : return the number of a module given its name +' - return 0 of the name is inexistant +'--------------------------------------------------------------------------------------- +' +Public Function getModuleNumber(module As String) As Integer + Dim r As Range + On Error Resume Next + Set r = configurationSheet.Columns(1) ' Select first column of the sheet + Set r = r.Offset(nbTitleRows, 0) ' Forget the two first rows + Set r = r.Find(what:=module, SearchOrder:=xlByColumns, LookAt:=xlWhole) + On Error GoTo 0 + If r Is Nothing Then + getModuleNumber = 0 + Else + getModuleNumber = r.Row - nbTitleRows + End If +End Function + +Public Function vtkConfigurationManager_getModuleNumber(module As String) As Integer + vtkConfigurationManager_getModuleNumber = getModuleNumber(module) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : addModule +' Author : Jean-Pierre Imbert +' Date : 26/05/2013 +' Purpose : Add a new module given its name +' - return the number of the added module +' - if the module is already existant, return minus the number of the existant module +'--------------------------------------------------------------------------------------- +' +Public Function addModule(module As String) As Integer + Dim n As Integer + n = getModuleNumber(module) + If n = 0 Then ' n = 0 means non-existant module + n = moduleCount + 1 ' Set module number + configurationSheet.Cells(n + nbTitleRows, 1) = module ' Write module name + Dim i As Integer + For i = 1 To configurationCount ' For each configuration + configurationSheet.Cells(n + nbTitleRows, i + nbTitleColumns) = "-" ' Set Default path as not initialized + Next i + addModule = n + Else + addModule = -n + End If +End Function + +Public Function vtkConfigurationManager_addModule(module As String) As Integer + vtkConfigurationManager_addModule = addModule(module) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : getModulePathWithNumber +' Author : Jean-Pierre Imbert +' Date : 26/05/2013 +' Purpose : Get a module relative path given its module and configuration numbers +' - return "" if the module or the configuration doesn't exist +' - return "" if the path is not initialized ("-" in the cell of the configuration sheet) +'--------------------------------------------------------------------------------------- +' +Public Function getModulePathWithNumber(numModule As Integer, numConfiguration As Integer) As String + Dim sResult As String + If numModule >= 1 And numModule <= moduleCount And numConfiguration >= 1 And numConfiguration <= configurationCount Then + sResult = configurationSheet.Cells(numModule + nbTitleRows, numConfiguration + nbTitleColumns) + If sResult = "-" Then sResult = "" + Else + sResult = "" + End If + getModulePathWithNumber = sResult +End Function + +Public Function vtkConfigurationManager_getModulePathWithNumber(numModule As Integer, numConfiguration As Integer) As String + vtkConfigurationManager_getModulePathWithNumber = getModulePathWithNumber(numModule, numConfiguration) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : setModulePathWithNumber +' Author : Jean-Pierre Imbert +' Date : 26/05/2013 +' Purpose : Set a module relative path given its module and configuration numbers +' - if the path given is "", it is replaced by "-" in the configuration sheet cell +'--------------------------------------------------------------------------------------- +' +Public Sub setModulePathWithNumber(path As String, numModule As Integer, numConfiguration As Integer) + Dim s As String + If numModule >= 1 And numModule <= moduleCount And numConfiguration >= 1 And numConfiguration <= configurationCount Then + If path = "" Then + s = "-" + Else + s = path + End If + configurationSheet.Cells(numModule + nbTitleRows, numConfiguration + nbTitleColumns) = s + End If +End Sub + +Public Sub vtkConfigurationManager_setModulePathWithNumber(path As String, numModule As Integer, numConfiguration As Integer) + setModulePathWithNumber path, numModule, numConfiguration +End Sub + +'--------------------------------------------------------------------------------------- +' Procedure : referenceManager, private +' Author : Jean-Pierre Imbert +' Date : 19/06/2014 +' Purpose : Return the reference manager associated with the configuration manager +'--------------------------------------------------------------------------------------- +' +Private Function referenceManager() As vtkReferenceManager + initReferences refs:=Nothing + Set referenceManager = m_refManager +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : references +' Author : Jean-Pierre Imbert +' Date : 19/06/2014 +' Purpose : Return a collection of all vtkReferences objects +'--------------------------------------------------------------------------------------- +' +Public Function references() As Collection + Set references = referenceManager.allReferences +End Function + +Public Function vtkConfigurationManager_references() As Collection + Set vtkConfigurationManager_references = references +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : initReferences +' Author : Jean-Pierre Imbert +' Date : 23/06/2014 +' Purpose : Initialize the references with the collection of vtkReference +'--------------------------------------------------------------------------------------- +' +Public Sub initReferences(refs As Collection) + If m_refManager Is Nothing Then + Set m_refManager = New vtkReferenceManager + m_refManager.init Wb:=Workbook, confCount:=Me.configurationCount, nbTitleColumnsInConfSheet:=nbTitleColumns, devConf:=m_devConfiguration, references:=refs + End If +End Sub + +'--------------------------------------------------------------------------------------- +' Procedure : duplicate +' Author : Jean-Pierre Imbert +' Date : 13/07/2014 +' Purpose : Duplicate a configuration manager +' This method is used when DEV configuration recreation +' Parameters : +' - wb, workBook in which the configuration manager mus be initialized +' an error is raised if the workbook already contains a configuration sheet +' - cm, the configuration manager from which to duplicate informations +' NOTE : Must be used with an uninitialized instance of conf manager (just created) +'--------------------------------------------------------------------------------------- +' +Public Sub duplicate(Wb As Workbook, cm As vtkConfigurationManager) + ' Check that the instance is uninitialized (no workbook attached) + Dim ws As Worksheet, i As Integer, j As Integer, ref As vtkReference, refs As Collection, refn As Integer + If Not m_workbook Is Nothing Then _ + Err.Raise Number:=VTK_ALREADY_INITIALIZED, Source:="vtkConfigurationManagerExcel:duplicate", Description:="The configuration manager to duplicate to is already initialized with an attached workbook." + ' Check that the wb is open (perhaps not if checked in following step) + If Wb Is Nothing Then _ + Err.Raise Number:=VTK_WORKBOOK_NOTOPEN, Source:="vtkConfigurationManagerExcel:duplicate", Description:="The workbook in which to is not opened." + ' Check that the wb has no configuration sheet + On Error Resume Next + Set ws = Wb.Worksheets(sheetName) + On Error GoTo 0 + If Not ws Is Nothing Then _ + Err.Raise Number:=VTK_ALREADY_INITIALIZED, Source:="vtkConfigurationManagerExcel:duplicate", Description:="The Excel workbook already contains a configuration sheet." + + ' attach wb, initialized conf sheet + Set m_workbook = Wb ' setConfigurationSheet needs a workbook + setConfigurationSheet ' NOTE: must be called before projectName set to not create the two standard confs + ' init projectName and rootPath from cm + m_projectName = cm.projectName + m_rootPath = cm.rootPath + ' create all configuration from cm + For i = 1 To cm.configurationCount + Me.addConfiguration configuration:=cm.configuration(i), path:=cm.getConfigurationPathWithNumber(i), _ + template:=cm.getConfigurationTemplateWithNumber(i), projectName:=cm.getConfigurationProjectNameWithNumber(i), _ + comment:=cm.getConfigurationCommentWithNumber(i) + Next i + ' call initReferences with the references from cm + Me.initReferences cm.references + ' create all modules from cm + For i = 1 To cm.moduleCount + Me.addModule module:=cm.module(i) + Next i + ' init module pathes for each configuration + For i = 1 To cm.configurationCount + For j = 1 To cm.moduleCount + Me.setModulePathWithNumber cm.getModulePathWithNumber(j, i), j, i + Next j + Next i + ' init reference usage for each configuration + For i = 1 To cm.configurationCount + Set refs = cm.getConfigurationReferencesWithNumber(i) + For j = 1 To refs.Count + Set ref = refs(j) + refn = CInt(Right(ref.id, Len(ref.id) - 1)) + referenceManager.setReferenceWihNumber True, refn, i + Next j + Next i +End Sub + + diff --git a/Source/ConfProd/vtkConfigurationManagerXML.cls b/Source/ConfProd/vtkConfigurationManagerXML.cls new file mode 100644 index 0000000..633f0bc --- /dev/null +++ b/Source/ConfProd/vtkConfigurationManagerXML.cls @@ -0,0 +1,610 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "vtkConfigurationManagerXML" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit +Implements vtkConfigurationManager +'--------------------------------------------------------------------------------------- +' Module : vtkConfigurationManagerXML, implements vtkConfigurationManager +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : Manage Configurations and Modules of a VTK Project +' - a Configuration is an Excel file containing Modules +' - for each configuration, a Module can be imported/exported to a specific path relative to the VTK Project directory +' - each configuration is a VBA project included in a specific Excel file whose path is relative to the VTK Project directory +' +' Usage: +' - Each instance of Configuration Manager is attached to the XML file describing a VTK project +' - the method init is used for this attachment +' +' NOTE : The XML configuration manager is read only +' a call to a setter function will cause an error +' +' Copyright 2014 Skwal-Soft (http://skwalsoft.com) +' +' Licensed under the Apache License, Version 2.0 (the "License"); +' you may not use this file except in compliance with the License. +' You may obtain a copy of the License at +' +' http://www.apache.org/licenses/LICENSE-2.0 +' +' Unless required by applicable law or agreed to in writing, software +' distributed under the License is distributed on an "AS IS" BASIS, +' WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +' See the License for the specific language governing permissions and +' limitations under the License. +'--------------------------------------------------------------------------------------- + +Private m_DOMDocument As DOMDocument +Private m_projectName As String +Private m_rootPath As String + +Private Sub Class_Terminate() + Set m_DOMDocument = Nothing +End Sub + +'--------------------------------------------------------------------------------------- +' Sub : init - Public +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : Attach the instance to an XML file, and initialize +' Parameter : XMLFilePath (absolute path) as a string +' Error detected : +' - VTK_WRONG_FILE_PATH if the XML file can't be opened +' - VTK_INVALID_XML_FILE if the XML File is not a V2.0 Configuration file +' - VTK_OBSOLETE_CONFIGURATION_SHEET if the XML file is not on the good version +' In case of error the instance keeps the previous DOM document +'--------------------------------------------------------------------------------------- +' +Public Sub init(ByVal XMLFilePath As String) + Dim fso As New FileSystemObject, DDoc As MSXML2.DOMDocument + Dim projectName As String, rootPath As String + If fso.FileExists(XMLFilePath) Then + Set DDoc = New MSXML2.DOMDocument + DDoc.Load XMLFilePath + DDoc.setProperty "SelectionLanguage", "XPath" ' for the use of the contains() function of XPath + If DDoc.parseError.ErrorCode <> 0 Then + Err.Raise Number:=VTK_INVALID_XML_FILE, Source:="init:vtkConfigurationManagerXML", Description:="Parse error of " & XMLFilePath & " : " & DDoc.parseError.reason + End If + If DDoc.SelectSingleNode("/vtkConf/info/vtkConfigurationsVersion").Text <> "2.0" Then + Err.Raise Number:=VTK_OBSOLETE_CONFIGURATION_SHEET, Source:="init:vtkConfigurationManagerXML", Description:="Bad version of XML File : 2.0 expected." + End If + On Error GoTo M_Error + projectName = DDoc.SelectSingleNode("/vtkConf/info/projectName").Text + rootPath = fso.GetParentFolderName(fso.GetParentFolderName(XMLFilePath)) + On Error GoTo 0 + Set m_DOMDocument = DDoc + m_projectName = projectName + m_rootPath = rootPath + Else + Err.Raise Number:=VTK_WRONG_FILE_PATH, Source:="init:vtkConfigurationManagerXML", Description:="The File " & XMLFilePath & " is unreachable." + End If + Exit Sub +M_Error: + Err.Raise Number:=VTK_INVALID_XML_FILE, Source:="init:vtkConfigurationManagerXML", Description:="Parse error of " & XMLFilePath & " : " & DDoc.parseError.reason +End Sub + +'--------------------------------------------------------------------------------------- +' Property : projectName as String - Read Only - Public +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : name of the project attached to this configuration manager +' NOTE : This is the Default property +' - "Attribute Value.VB_UserMemId = 0" is added as first line of property Get (in exported Module) +' WARNING : The attribute must be explicitly added after each export, or just before import +'--------------------------------------------------------------------------------------- +' +Public Property Get projectName() As String + projectName = m_projectName +End Property + +Public Property Get vtkConfigurationManager_projectName() As String + vtkConfigurationManager_projectName = projectName +End Property + +'--------------------------------------------------------------------------------------- +' Property : rootPath as String - Read Only - Public +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : return the rootPath of the project +' - or return "" if the rootPath can't be determined +'--------------------------------------------------------------------------------------- +' +Public Property Get rootPath() As String + rootPath = m_rootPath +End Property + +Public Property Get vtkConfigurationManager_rootPath() As String + vtkConfigurationManager_rootPath = rootPath +End Property + +'--------------------------------------------------------------------------------------- +' Property : configurationCount as Integer - Read Only - Public +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : Get the number of configurations +'--------------------------------------------------------------------------------------- +' +Public Property Get configurationCount() As Integer + configurationCount = m_DOMDocument.SelectNodes("/vtkConf/configuration").Length +End Property + +Public Property Get vtkConfigurationManager_configurationCount() As Integer + vtkConfigurationManager_configurationCount = configurationCount +End Property + +'--------------------------------------------------------------------------------------- +' Function : configuration +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : return the n-th configuration of the project, given n as integer +' - return "" if the configuration is inexistant +'--------------------------------------------------------------------------------------- +' +Public Function configuration(n As Integer) As String + If n > 0 And n <= configurationCount Then + configuration = m_DOMDocument.SelectSingleNode("/vtkConf/configuration[@cID=""c" & n & """]/name").Text + Else + configuration = "" + End If +End Function + +Public Function vtkConfigurationManager_configuration(n As Integer) As String + vtkConfigurationManager_configuration = configuration(n) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : raiseReadOnlyError +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : Return the Error VTK_READONLY_FILE because XML file is unmodifiable +'--------------------------------------------------------------------------------------- +' +Private Sub raiseReadOnlyError(Source As String) + Err.Raise Number:=VTK_READONLY_FILE, Source:=source, Description:="A XML Configuration File is considered Read-Only" +End Sub + +'--------------------------------------------------------------------------------------- +' Procedure : addConfiguration +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : Return the Error VTK_READONLY_FILE because XML file is unmodifiable +'--------------------------------------------------------------------------------------- +' +Public Function addConfiguration(configuration As String, Optional path As String = "", Optional template As String = "", Optional projectName As String = "", Optional comment As String = "") As Integer + raiseReadOnlyError Source:="addConfiguration:vtkConfigurationManagerXML" +End Function + +Public Function vtkConfigurationManager_addConfiguration(configuration As String, Optional path As String = "", Optional template As String = "", Optional projectName As String = "", Optional comment As String = "") As Integer + vtkConfigurationManager_addConfiguration = addConfiguration(configuration, path, template, projectName, comment) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : configurations +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : Return a collection of initialized vtkConfiguration objects +'--------------------------------------------------------------------------------------- +' +Public Function configurations() As Collection + Dim col As New Collection, i As Integer, c As vtkConfiguration + For i = 1 To configurationCount + Set c = New vtkConfiguration + c.init confManager:=Me, confNumber:=i + col.Add Item:=c, Key:=configuration(i) + Next i + Set configurations = col +End Function + +Public Function vtkConfigurationManager_configurations() As Collection + Set vtkConfigurationManager_configurations = configurations +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : getConfigurationNumber +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : return the number of a configuration given its name +' - return 0 of the name is inexistant +'--------------------------------------------------------------------------------------- +' +Public Function getConfigurationNumber(configuration As String) As Integer + Dim textValue As String + On Error Resume Next + textValue = m_DOMDocument.SelectSingleNode("/vtkConf/configuration[name=""" & configuration & """]/@cID").Text + On Error GoTo 0 + If textValue = "" Then + getConfigurationNumber = 0 + Else + getConfigurationNumber = CInt(Right$(textValue, Len(textValue) - 1)) + End If +End Function + +Public Function vtkConfigurationManager_getConfigurationNumber(configuration As String) As Integer + vtkConfigurationManager_getConfigurationNumber = getConfigurationNumber(configuration) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : getConfigurationPathWithNumber +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : return the n-th relative configuration path of the project, given n as integer +' - return "" if the configuration is inexistant +'--------------------------------------------------------------------------------------- +' +Public Function getConfigurationPathWithNumber(n As Integer) As String + If n > 0 And n <= configurationCount Then + getConfigurationPathWithNumber = m_DOMDocument.SelectSingleNode("/vtkConf/configuration[@cID=""c" & n & """]/path").Text + Else + getConfigurationPathWithNumber = "" + End If +End Function + +Public Function vtkConfigurationManager_getConfigurationPathWithNumber(n As Integer) As String + vtkConfigurationManager_getConfigurationPathWithNumber = getConfigurationPathWithNumber(n) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : setConfigurationPathWithNumber +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : Return the Error VTK_READONLY_FILE because XML file is unmodifiable +'--------------------------------------------------------------------------------------- +' +Public Sub setConfigurationPathWithNumber(n As Integer, path As String) + raiseReadOnlyError Source:="setConfigurationPathWithNumber:vtkConfigurationManagerXML" +End Sub + +Public Sub vtkConfigurationManager_setConfigurationPathWithNumber(n As Integer, path As String) + setConfigurationPathWithNumber n, path +End Sub + +'--------------------------------------------------------------------------------------- +' Function : getConfigurationPath +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : return the relative path of a configuration given its name +' - return "" of the name is inexistant +'--------------------------------------------------------------------------------------- +' +Public Function getConfigurationPath(configuration As String) As String + getConfigurationPath = getConfigurationPathWithNumber(getConfigurationNumber(configuration)) +End Function + +Public Function vtkConfigurationManager_getConfigurationPath(configuration As String) As String + vtkConfigurationManager_getConfigurationPath = getConfigurationPath(configuration) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : setConfigurationPath +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : Return the Error VTK_READONLY_FILE because XML file is unmodifiable +'--------------------------------------------------------------------------------------- +' +Public Sub setConfigurationPath(configuration As String, path As String) + raiseReadOnlyError Source:="setConfigurationPath:vtkConfigurationManagerXML" +End Sub + +Public Sub vtkConfigurationManager_setConfigurationPath(configuration As String, path As String) + setConfigurationPath configuration, path +End Sub + +'--------------------------------------------------------------------------------------- +' Procedure : getConfigurationProjectNameWithNumber +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : return the n-th configuration project name of the project, given n as integer +' - return "" if the configuration is inexistant +' - return the default project name if +' - it is not initialized in the configuration sheet v1.1 +' - the configuration sheet is v1.0, so there is no project name field +'--------------------------------------------------------------------------------------- +' +Public Function getConfigurationProjectNameWithNumber(n As Integer) As String + If n > 0 And n <= configurationCount Then + getConfigurationProjectNameWithNumber = m_DOMDocument.SelectSingleNode("/vtkConf/configuration[@cID=""c" & n & """]/title").Text + Else + getConfigurationProjectNameWithNumber = "" + End If +End Function + +Public Function vtkConfigurationManager_getConfigurationProjectNameWithNumber(n As Integer) As String + vtkConfigurationManager_getConfigurationProjectNameWithNumber = getConfigurationProjectNameWithNumber(n) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : setConfigurationProjectNameWithNumber +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : Return the Error VTK_READONLY_FILE because XML file is unmodifiable +'--------------------------------------------------------------------------------------- +' +Public Sub setConfigurationProjectNameWithNumber(n As Integer, projectName As String) + raiseReadOnlyError Source:="setConfigurationProjectNameWithNumber:vtkConfigurationManagerXML" +End Sub + +Public Sub vtkConfigurationManager_setConfigurationProjectNameWithNumber(n As Integer, projectName As String) + setConfigurationProjectNameWithNumber n, projectName +End Sub + +'--------------------------------------------------------------------------------------- +' Procedure : getConfigurationCommentWithNumber +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : return the n-th configuration comment of the project, given n as integer +' - return "" if the configuration is inexistant +' - return the default comment if +' - it is not initialized in the configuration sheet v1.1 +' - the configuration sheet is v1.0, so there is no comment field +'--------------------------------------------------------------------------------------- +' +Public Function getConfigurationCommentWithNumber(n As Integer) As String + If n > 0 And n <= configurationCount Then + getConfigurationCommentWithNumber = m_DOMDocument.SelectSingleNode("/vtkConf/configuration[@cID=""c" & n & """]/comment").Text + Else + getConfigurationCommentWithNumber = "" + End If +End Function + +Public Function vtkConfigurationManager_getConfigurationCommentWithNumber(n As Integer) As String + vtkConfigurationManager_getConfigurationCommentWithNumber = getConfigurationCommentWithNumber(n) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : setConfigurationCommentWithNumber +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : Return the Error VTK_READONLY_FILE because XML file is unmodifiable +'--------------------------------------------------------------------------------------- +' +Public Sub setConfigurationCommentWithNumber(n As Integer, comment As String) + raiseReadOnlyError Source:="setConfigurationCommentWithNumber:vtkConfigurationManagerXML" +End Sub + +Public Sub vtkConfigurationManager_setConfigurationCommentWithNumber(n As Integer, comment As String) + setConfigurationCommentWithNumber n, comment +End Sub + +'--------------------------------------------------------------------------------------- +' Procedure : getConfigurationTemplateWithNumber +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : return the n-th configuration Excel template path of the project, given n as integer +' - return "" if the configuration is inexistant +' - return the default comment if +' - it is not initialized in the configuration sheet v1.1 +' - the configuration sheet is v1.0, so there is no comment field +'--------------------------------------------------------------------------------------- +' +Public Function getConfigurationTemplateWithNumber(n As Integer) As String + If n > 0 And n <= configurationCount Then + On Error Resume Next + getConfigurationTemplateWithNumber = m_DOMDocument.SelectSingleNode("/vtkConf/configuration[@cID=""c" & n & """]/templatePath").Text + On Error GoTo 0 + Else + getConfigurationTemplateWithNumber = "" + End If +End Function + +Public Function vtkConfigurationManager_getConfigurationTemplateWithNumber(n As Integer) As String + vtkConfigurationManager_getConfigurationTemplateWithNumber = getConfigurationTemplateWithNumber(n) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : setConfigurationTemplateWithNumber +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : Return the Error VTK_READONLY_FILE because XML file is unmodifiable +'--------------------------------------------------------------------------------------- +' +Public Sub setConfigurationTemplateWithNumber(n As Integer, template As String) + raiseReadOnlyError Source:="setConfigurationTemplateWithNumber:vtkConfigurationManagerXML" +End Sub + +Public Sub vtkConfigurationManager_setConfigurationTemplateWithNumber(n As Integer, template As String) + setConfigurationTemplateWithNumber n, template +End Sub + +'--------------------------------------------------------------------------------------- +' Function : vtkReferenceWithXML, private +' Author : Jean-Pierre Imbert +' Date : 08/07/2014 +' Purpose : Create and init a vtkReference with XML, given an Id +'--------------------------------------------------------------------------------------- +' +Private Function vtkReferenceWithXML(id As String) As vtkReference + Dim ref As New vtkReference + ref.id = id + ref.name = m_DOMDocument.SelectSingleNode("/vtkConf/reference[@refID=""" & id & """]/name").Text + On Error Resume Next + ref.GUID = m_DOMDocument.SelectSingleNode("/vtkConf/reference[@refID=""" & id & """]/guid").Text + If Err.Number <> 0 Then + Err.Number = 0 + ref.fullPath = m_DOMDocument.SelectSingleNode("/vtkConf/reference[@refID=""" & id & """]/path").Text + End If + On Error GoTo 0 + Set vtkReferenceWithXML = ref +End Function +'--------------------------------------------------------------------------------------- +' Procedure : getConfigurationReferencesWithNumber +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : return the n-th configuration references collection of the project, given n as integer +'--------------------------------------------------------------------------------------- +' +Public Function getConfigurationReferencesWithNumber(n As Integer) As Collection + Dim refIDs() As String, i As Integer, refs As New Collection + On Error GoTo M_Error + refIDs = Split(m_DOMDocument.SelectSingleNode("/vtkConf/configuration[@cID=""c" & n & """]").Attributes.getNamedItem("refIDs").Text) + On Error GoTo 0 + For i = LBound(refIDs) To UBound(refIDs) + refs.Add vtkReferenceWithXML(refIDs(i)), Key:=refIDs(i) + Next i +M_Error: ' refIDs attribute is optional + Set getConfigurationReferencesWithNumber = refs +End Function + +Public Function vtkConfigurationManager_getConfigurationReferencesWithNumber(n As Integer) As Collection + Set vtkConfigurationManager_getConfigurationReferencesWithNumber = getConfigurationReferencesWithNumber(n) +End Function + +'--------------------------------------------------------------------------------------- +' Property : moduleCount as Integer - Read Only - Public +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : Get the number of modules +'--------------------------------------------------------------------------------------- +' +Public Property Get moduleCount() As Integer + moduleCount = m_DOMDocument.SelectNodes("/vtkConf/module").Length +End Property + +Public Property Get vtkConfigurationManager_moduleCount() As Integer + vtkConfigurationManager_moduleCount = moduleCount() +End Property + +'--------------------------------------------------------------------------------------- +' Procedure : modules +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : Return a collection of initialized vtkModule objects +'--------------------------------------------------------------------------------------- +' +Public Function modules() As Collection + Dim col As New Collection, i As Integer, m As vtkModule + For i = 1 To moduleCount + Set m = New vtkModule + m.init confManager:=Me, modNumber:=i + col.Add Item:=m, Key:=module(i) + Next i + Set modules = col +End Function + +Public Function vtkConfigurationManager_modules() As Collection + Set vtkConfigurationManager_modules = modules +End Function + +'--------------------------------------------------------------------------------------- +' Function : module +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : return the n-th module of the project, given n as integer +' - return "" if the module is inexistant +'--------------------------------------------------------------------------------------- +' +Public Function module(n As Integer) As String + If n > 0 And n <= moduleCount Then + module = m_DOMDocument.SelectSingleNode("/vtkConf/module[@mID=""m" & n & """]/name").Text + Else + module = "" + End If +End Function + +Public Function vtkConfigurationManager_module(n As Integer) As String + vtkConfigurationManager_module = module(n) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : getModuleNumber +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : return the number of a module given its name +' - return 0 of the name is inexistant +'--------------------------------------------------------------------------------------- +' +Public Function getModuleNumber(module As String) As Integer + Dim textValue As String + On Error Resume Next + textValue = m_DOMDocument.SelectSingleNode("/vtkConf/module[name=""" & module & """]/@mID").Text + On Error GoTo 0 + If textValue = "" Then + getModuleNumber = 0 + Else + getModuleNumber = CInt(Right$(textValue, Len(textValue) - 1)) + End If +End Function + +Public Function vtkConfigurationManager_getModuleNumber(module As String) As Integer + vtkConfigurationManager_getModuleNumber = getModuleNumber(module) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : addModule +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : Return the Error VTK_READONLY_FILE because XML file is unmodifiable +'--------------------------------------------------------------------------------------- +' +Public Function addModule(module As String) As Integer + raiseReadOnlyError Source:="addModule:vtkConfigurationManagerXML" +End Function + +Public Function vtkConfigurationManager_addModule(module As String) As Integer + vtkConfigurationManager_addModule = addModule(module) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : getModulePathWithNumber +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : Get a module relative path given its module and configuration numbers +' - return "" if the module or the configuration doesn't exist +' - return "" if the path is not initialized ("-" in the cell of the configuration sheet) +'--------------------------------------------------------------------------------------- +' +Public Function getModulePathWithNumber(numModule As Integer, numConfiguration As Integer) As String + If numModule > 0 And numModule <= moduleCount And numConfiguration > 0 And numConfiguration <= configurationCount Then + On Error Resume Next + getModulePathWithNumber = m_DOMDocument.SelectSingleNode("/vtkConf/module[@mID=""m" & numModule & """]/modulePath[@confId=""c" & numConfiguration & """]").Text + On Error GoTo 0 + Else + getModulePathWithNumber = "" + End If +End Function + +Public Function vtkConfigurationManager_getModulePathWithNumber(numModule As Integer, numConfiguration As Integer) As String + vtkConfigurationManager_getModulePathWithNumber = getModulePathWithNumber(numModule, numConfiguration) +End Function + +'--------------------------------------------------------------------------------------- +' Procedure : setModulePathWithNumber +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : Set a module relative path given its module and configuration numbers +' - if the path given is "", it is replaced by "-" in the configuration sheet cell +'--------------------------------------------------------------------------------------- +' +Public Sub setModulePathWithNumber(path As String, numModule As Integer, numConfiguration As Integer) + raiseReadOnlyError Source:="setModulePathWithNumber:vtkConfigurationManagerXML" +End Sub + +Public Sub vtkConfigurationManager_setModulePathWithNumber(path As String, numModule As Integer, numConfiguration As Integer) + setModulePathWithNumber path, numModule, numConfiguration +End Sub + +'--------------------------------------------------------------------------------------- +' Procedure : references +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : Return a collection of all vtkReferences objects +'--------------------------------------------------------------------------------------- +' +Public Function references() As Collection + Dim i As Integer, refs As New Collection, id As String + For i = 1 To m_DOMDocument.SelectNodes("/vtkConf/reference").Length + id = "r" & i + refs.Add vtkReferenceWithXML(id), Key:=id + Next i + Set references = refs +End Function + +Public Function vtkConfigurationManager_references() As Collection + Set vtkConfigurationManager_references = references +End Function + diff --git a/Source/ConfProd/vtkConfigurationManagers.bas b/Source/ConfProd/vtkConfigurationManagers.bas index 8a068a1..cac3679 100644 --- a/Source/ConfProd/vtkConfigurationManagers.bas +++ b/Source/ConfProd/vtkConfigurationManagers.bas @@ -10,6 +10,9 @@ Option Explicit ' - Each instance of Configuration Manager is attached to the DEV Excel Workbook of a project ' - the method vtkConfigurationManagerForProject give the instance attached to a workbook, or create it ' +' NOTE : For now this module uses only Excel Configuration Managers +' The use of XML configuration managers needs a centralized Project management +' ' Copyright 2013 Skwal-Soft (http://skwalsoft.com) ' ' Licensed under the Apache License, Version 2.0 (the "License"); @@ -54,8 +57,10 @@ Public Function vtkConfigurationManagerForProject(projectName As String) As vtkC On Error Resume Next Set cm = configurationManagers(projectName) If Err <> 0 Then - Set cm = New vtkConfigurationManager - cm.projectName = projectName + Set cm = New vtkConfigurationManagerExcel + Dim cmE As vtkConfigurationManagerExcel + Set cmE = cm + cmE.projectName = projectName ' The projectName setter is specific to the Excel conf Manager If cm.projectName Like projectName Then ' The initialization could fail (if the Workbook is closed) configurationManagers.Add Item:=cm, Key:=projectName Else @@ -85,6 +90,7 @@ End Sub ' ' WARNING 1 : for now used only with manual run to convert a VBA project for VBAToolkit ' WARNING 2 : A beforeSave event handler is added even if one is already existing +' WARNING 3 : This function must use an Excel Configuration Manager (not XML) ' ' Purpose : Create and Initialize a vtkConfiguration sheet for the active workbook ' - does nothing if the active workbook already contains a vtkConfiguration worksheet @@ -99,7 +105,7 @@ End Sub ' Public Sub vtkInitializeConfigurationForActiveWorkBook(Optional withBeforeSaveHandler As Boolean = False) ' If a configuration sheet exists, does nothing - Dim cm As New vtkConfigurationManager + Dim cm As New vtkConfigurationManagerExcel If cm.isConfigurationInitializedForWorkbook(ExcelName:=ActiveWorkbook.name) Then Exit Sub Set cm = Nothing diff --git a/Source/ConfProd/vtkConstants.bas b/Source/ConfProd/vtkConstants.bas index 6eaf23c..823529b 100644 --- a/Source/ConfProd/vtkConstants.bas +++ b/Source/ConfProd/vtkConstants.bas @@ -38,8 +38,11 @@ Public Const VTK_WORKBOOK_ALREADY_OPEN = 4004 Public Const VTK_NO_SOURCE_FILES = 4005 Public Const VTK_OBSOLETE_CONFIGURATION_SHEET = 4006 Public Const VTK_NOTINITIALIZED = 4007 -Public Const VTK_INVALID_FIELD = 4008 -Public Const VTK_TEMPLATE_NOT_FOUND = 4009 +Public Const VTK_ALREADY_INITIALIZED = 4008 +Public Const VTK_INVALID_FIELD = 4009 +Public Const VTK_TEMPLATE_NOT_FOUND = 4010 +Public Const VTK_INVALID_XML_FILE = 4011 +Public Const VTK_READONLY_FILE = 4012 Public Const VTK_UNEXPECTED_CHAR = 5001 Public Const VTK_UNEXPECTED_EOS = 5002 diff --git a/Source/ConfProd/vtkGitFunctions.bas b/Source/ConfProd/vtkGitFunctions.bas index 3fd972c..f86a01e 100644 --- a/Source/ConfProd/vtkGitFunctions.bas +++ b/Source/ConfProd/vtkGitFunctions.bas @@ -121,6 +121,9 @@ Public Function vtkInitializeGit(folderPath As String, Optional logFile As Strin contentStream.WriteLine contentStream.WriteLine "# Ignore the delivery Excel files" contentStream.WriteLine "/Delivery/*.xl*" + contentStream.WriteLine + contentStream.WriteLine "# Ignore the Project Excel files" + contentStream.WriteLine "/Project/*.xl*" contentStream.Close ' Adds all the files in the folder tree to the git repository diff --git a/Source/ConfProd/vtkImportExportUtilities.bas b/Source/ConfProd/vtkImportExportUtilities.bas index f670c41..97321e8 100644 --- a/Source/ConfProd/vtkImportExportUtilities.bas +++ b/Source/ConfProd/vtkImportExportUtilities.bas @@ -321,14 +321,13 @@ End Sub ' - the modules are imported from pathes listed in project/configuration '--------------------------------------------------------------------------------------- ' -Public Sub vtkImportModulesInAnotherProject(projectForModules As VBProject, projectName As String, confName As String) - Dim cm As vtkConfigurationManager, rootPath As String - Dim cn As Integer, filePath As String, i As Integer +Public Sub vtkImportModulesInAnotherProject(projectForModules As VBProject, projectName As String, confName As String, Optional cm As vtkConfigurationManager = Nothing) + Dim rootPath As String, cn As Integer, filePath As String, i As Integer On Error GoTo vtkImportModulesInAnotherProject_Error ' Get the project and the rootPath of the project - Set cm = vtkConfigurationManagerForProject(projectName) + If cm Is Nothing Then Set cm = vtkConfigurationManagerForProject(projectName) cn = cm.getConfigurationNumber(configuration:=confName) rootPath = cm.rootPath @@ -354,6 +353,9 @@ End Sub ' ' Params : - projectName ' - configurationName +' - Optional Configuration Manager +' if no Conf Manager are given, the standard Conf manager (Excel) +' of the project is used ' ' Raises : - VTK_UNEXPECTED_ERROR ' - VTK_WORKBOOK_ALREADY_OPEN @@ -366,7 +368,7 @@ End Sub ' '--------------------------------------------------------------------------------------- ' -Public Sub vtkRecreateConfiguration(projectName As String, configurationName As String) +Public Sub vtkRecreateConfiguration(projectName As String, configurationName As String, Optional confManager As vtkConfigurationManager = Nothing) Dim cm As vtkConfigurationManager Dim rootPath As String Dim wbPath As String, templatePath As String @@ -376,8 +378,12 @@ Public Sub vtkRecreateConfiguration(projectName As String, configurationName As On Error GoTo vtkRecreateConfiguration_Error - ' Get the project and the rootPath of the project - Set cm = vtkConfigurationManagerForProject(projectName) + ' Get the Conf Manager and the rootPath of the project + If confManager Is Nothing Then + Set cm = vtkConfigurationManagerForProject(projectName) + Else + Set cm = confManager + End If rootPath = cm.rootPath ' Get the configuration number in the project and the path of the file @@ -419,11 +425,17 @@ Public Sub vtkRecreateConfiguration(projectName As String, configurationName As Wb.BuiltinDocumentProperties("Comments").Value = conf.comment ' Import all modules for this configuration from the source directory - vtkImportModulesInAnotherProject projectForModules:=Wb.VBProject, projectName:=projectName, confName:=configurationName + vtkImportModulesInAnotherProject projectForModules:=Wb.VBProject, projectName:=projectName, confName:=configurationName, cm:=cm ' Recreate references in the new Excel File conf.addReferencesToWorkbook Wb + ' Duplicate Conf Manager if DEV configuration + If conf.isDEV Then + Dim cmE As New vtkConfigurationManagerExcel + cmE.duplicate wb, cm + End If + ' VB will not let the workbook be saved under the name of an already opened workbook, which ' is annoying when recreating an add-in (always opened). The following code works around this. Dim tmpPath As String @@ -480,7 +492,7 @@ vtkRecreateConfiguration_Error: Err.Number = VTK_UNEXPECTED_ERROR End Select - Err.Raise Err.Number, Err.Source, Err.Description + Err.Raise Err.Number, Err.source, Err.Description Exit Sub diff --git a/Source/ConfProd/vtkMainFunctions.bas b/Source/ConfProd/vtkMainFunctions.bas index c89cea0..262afc2 100644 --- a/Source/ConfProd/vtkMainFunctions.bas +++ b/Source/ConfProd/vtkMainFunctions.bas @@ -126,33 +126,18 @@ End Function '--------------------------------------------------------------------------------------- ' Procedure : vtkRecreateConfigurations ' Author : Jean-Pierre Imbert -' Date : 08/06/2014 +' Date : 15/07/2014 ' Purpose : recreate one or several configurations ' Parameters : -' - projectName, string containing the name of the project whose configurations has to be recreate -' - confName, string containing the name of configuration -' - AllExceptSelected, boolean true if all configurations but confName have to be recreated +' - confManager, configuration manager for the configurations to recreate +' - confNames, Colelction of the name of the configurations to recreate ' '--------------------------------------------------------------------------------------- ' -Public Sub vtkRecreateConfigurations(projectName As String, confName As String, Optional AllExceptSelected As Boolean = False) - On Error GoTo vtkRecreateConfigurations_Error - - If Not AllExceptSelected Then - vtkRecreateConfiguration projectName, confName - Else - Dim conf As vtkConfiguration, cm As vtkConfigurationManager - Set cm = vtkConfigurationManagerForProject(projectName) - For Each conf In cm.configurations - If Not conf.name Like confName Then - vtkRecreateConfiguration projectName, conf.name - End If - Next - End If - - On Error GoTo 0 - Exit Sub - -vtkRecreateConfigurations_Error: - Err.Raise Err.Number, Err.Source, Err.Description +Public Sub vtkRecreateConfigurations(confManager As vtkConfigurationManager, confNames As Collection) + Dim c As Variant, confName As String + For Each c In confNames + confName = c + vtkRecreateConfiguration confManager.projectName, confName, confManager + Next c End Sub diff --git a/Source/ConfProd/vtkProjectCreationUtilities.bas b/Source/ConfProd/vtkProjectCreationUtilities.bas index 4b94750..1026224 100644 --- a/Source/ConfProd/vtkProjectCreationUtilities.bas +++ b/Source/ConfProd/vtkProjectCreationUtilities.bas @@ -28,6 +28,7 @@ Option Explicit ' Date : 09/05/2013 ' Purpose : - Initialize DEV project ConfSheet with vbaunit module names and pathes ' - Return True if module names and paths are initialized without error +' WARNING : This function must use an Excel ConfigurationManager (not XML) '--------------------------------------------------------------------------------------- ' Public Function vtkInitializeVbaUnitNamesAndPathes(project As String) As Boolean @@ -112,6 +113,7 @@ Public Sub vtkAddBeforeSaveHandlerInDEVWorkbook(Wb As Workbook, projectName As S Dim handlerString As String handlerString = _ "Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)" & vbNewLine & _ + " On error goto M_Error" & vbNewLine & _ " " & wbVTKName & ".vtkExportConfiguration projectWithModules:=ThisWorkbook.VBProject, projectName:=" & """" & projectName & """" & _ " , confName:=" & """" & confName & """" & _ " , onlyModified:=True" & _ @@ -119,6 +121,7 @@ Public Sub vtkAddBeforeSaveHandlerInDEVWorkbook(Wb As Workbook, projectName As S vbNewLine & _ " " & wbVTKName & ".vtkExportConfigurationsAsXML projectName:=""" & projectName & """, filePath:=" & _ wbVTKName & ".vtkPathOfCurrentProject(ThisWorkbook) & ""\"" & " & wbVTKName & ".vtkProjectForName(""" & projectName & """).XMLConfigurationStandardRelativePath" & vbNewLine & _ + "M_Error:" & vbNewLine & _ "End Sub" & vbNewLine With Wb.VBProject.VBComponents("ThisWorkbook").CodeModule diff --git a/Source/ConfProd/vtkRecreateConfigurationForm.frm b/Source/ConfProd/vtkRecreateConfigurationForm.frm index 3f3f9d6..c9a5d69 100644 --- a/Source/ConfProd/vtkRecreateConfigurationForm.frm +++ b/Source/ConfProd/vtkRecreateConfigurationForm.frm @@ -1,10 +1,10 @@ VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} vtkRecreateConfigurationForm Caption = "Recreate Configuration" - ClientHeight = 3120 + ClientHeight = 4485 ClientLeft = 45 ClientTop = 435 - ClientWidth = 4710 + ClientWidth = 4680 OleObjectBlob = "vtkRecreateConfigurationForm.frx":0000 StartUpPosition = 1 'CenterOwner End @@ -13,14 +13,13 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False - - +Option Explicit '--------------------------------------------------------------------------------------- ' Module : vtkCreateProjectForm -' Author : Lucas Vitorino +' Author : Jean-Pierre IMBERT ' Purpose : UserForm for VBAToolKit configuration recreation ' -' Copyright 2013 Skwal-Soft (http://skwalsoft.com) +' Copyright 2014 Skwal-Soft (http://skwalsoft.com) ' ' Licensed under the Apache License, Version 2.0 (the "License"); ' you may not use this file except in compliance with the License. @@ -36,9 +35,31 @@ Attribute VB_Exposed = False '--------------------------------------------------------------------------------------- -Private cm As vtkConfigurationManager -Private currentConf As vtkConfiguration -Private currentProjectName As String +Private m_confManager As vtkConfigurationManager +Private m_XMLFilePath As String +Private m_XMLFileOK As Boolean +Private m_ConfSelected As Boolean + +Private Const PINK = &HC0E0FF +Private Const GREEN = &HC0FFC0 + + +'--------------------------------------------------------------------------------------- +' Procedure : BrowseButton_Click +' Author : Jean-Pierre Imbert +' Date : 15/07/2014 +' Purpose : Open a browse window and initialize the XML Configuration File Text field +'--------------------------------------------------------------------------------------- +' +Private Sub BrowseButton_Click() + With Application.FileDialog(msoFileDialogFilePicker) + .AllowMultiSelect = False + .Show + If .SelectedItems.Count > 0 Then + XMLFileTextBox.Text = .SelectedItems(1) + End If + End With +End Sub '--------------------------------------------------------------------------------------- ' Procedure : UserForm_Initialize @@ -47,71 +68,41 @@ Private currentProjectName As String '--------------------------------------------------------------------------------------- ' Private Sub UserForm_Initialize() - - ' Get the name of the current DEV workbook - currentProjectName = getCurrentProjectName - - ' Initialize configuration manager - Set cm = vtkConfigurationManagerForProject(currentProjectName) - ' Disable the "Create Configuration" button as no configuration is selected - enableCreateConfigurationButton - - ' Initialize the content of the combo box - If Not cm Is Nothing Then - Dim conf As vtkConfiguration - For Each conf In cm.configurations - ConfigurationComboBox.AddItem (conf.name) - Next - End If + ' Select the previous XML File Path if any + XMLFileTextBox.Text = m_XMLFilePath + validateXMLFileTextBox -End Sub + ' Disable the "Create Configuration" button as no configuration is selected + enableReCreateButton +End Sub '--------------------------------------------------------------------------------------- -' Procedure : ConfigurationComboBox_Change -' Author : Lucas Vitorino -' Purpose : Manage the combo box containing the list of configurations +' Procedure : ConfigurationListBox_AfterUpdate +' Author : Jean-Pierre Imbert +' Purpose : Manage the list box containing the list of configurations '--------------------------------------------------------------------------------------- ' -Private Sub ConfigurationComboBox_Change() - - On Error GoTo ConfigurationComboBox_Change_Error - - Set currentConf = cm.configurations(ConfigurationComboBox.Value) - - If AllConfigurationsExceptThisOneCheckBox.Value = False Then - PathTextBox.Text = currentConf.path - End If - - enableCreateConfigurationButton - - On Error GoTo 0 - Exit Sub - -ConfigurationComboBox_Change_Error: - Set currentConf = Nothing - Resume Next +Private Sub ConfigurationListBox_AfterUpdate() + If m_ConfSelected Then ConfigurationListBox.BackColor = GREEN Else ConfigurationListBox.BackColor = PINK End Sub - '--------------------------------------------------------------------------------------- -' Procedure : AllConfigurationsExceptThisOneCheckBox_Change -' Author : Lucas Vitorino -' Purpose : Manage what happens when the checkbox changes. +' Procedure : ConfigurationListBox_Change +' Author : Jean-Pierre Imbert +' Purpose : Manage the list box containing the list of configurations '--------------------------------------------------------------------------------------- ' -Private Sub AllConfigurationsExceptThisOneCheckBox_Change() - - If AllConfigurationsExceptThisOneCheckBox.Value = True Or currentConf Is Nothing Then - PathTextBox.Text = "" - Else - PathTextBox.Text = currentConf.path - End If - +Private Sub ConfigurationListBox_Change() + Dim i As Integer + m_ConfSelected = False + For i = 0 To ConfigurationListBox.ListCount - 1 + m_ConfSelected = m_ConfSelected Or ConfigurationListBox.Selected(i) + Next i + enableReCreateButton End Sub - '--------------------------------------------------------------------------------------- ' Procedure : CancelButton_Click ' Author : Lucas Vitorino @@ -119,7 +110,7 @@ End Sub '--------------------------------------------------------------------------------------- ' Private Sub CancelButton_Click() - Unload vtkRecreateConfigurationForm + vtkRecreateConfigurationForm.Hide End Sub @@ -130,20 +121,65 @@ End Sub '--------------------------------------------------------------------------------------- ' Private Sub CreateConfigurationButton_Click() - vtkRecreateConfigurations projectName:=currentProjectName, confName:=currentConf.name, AllExceptSelected:=AllConfigurationsExceptThisOneCheckBox.Value + Me.Hide + ' display wait message modeless for the present code to keep running + vtkWaitForm.Show vbModeless + ' build the confNames collection + Dim confNames As New Collection, i As Integer + For i = 0 To ConfigurationListBox.ListCount - 1 + If ConfigurationListBox.Selected(i) Then confNames.Add ConfigurationListBox.List(i) + Next i + ' recreate configurations + vtkRecreateConfigurations m_confManager, confNames + ' Hide wait message + vtkWaitForm.Hide End Sub - '--------------------------------------------------------------------------------------- -' Procedure : enableCreateConfigurationButton -' Author : Lucas Vitorino -' Purpose : Decide if the "Create Configuration" button should be enabled or disabled. +' Procedure : validateXMLFileTextBox +' Author : Jean-Pierre Imbert +' Date : 15/07/2014 +' Purpose : Check the XMLFileTextBox and establish status of the form +' '--------------------------------------------------------------------------------------- ' -Private Sub enableCreateConfigurationButton() - If currentConf Is Nothing Then - CreateConfigurationButton.Enabled = False - Else - CreateConfigurationButton.Enabled = True +Private Sub validateXMLFileTextBox() + Dim cmX As New vtkConfigurationManagerXML, conf As vtkConfiguration + On Error Resume Next + cmX.init XMLFileTextBox.Text + m_XMLFileOK = (Err.Number = 0) + On Error GoTo 0 + ConfigurationListBox.Clear + m_ConfSelected = False + If m_XMLFileOK Then + XMLFileTextBox.BackColor = GREEN + m_XMLFilePath = XMLFileTextBox.Text + Set m_confManager = cmX + For Each conf In m_confManager.configurations + ConfigurationListBox.AddItem conf.name + Next conf + Else + XMLFileTextBox.BackColor = PINK + m_XMLFilePath = "" + Set m_confManager = Nothing End If + enableReCreateButton +End Sub + +'--------------------------------------------------------------------------------------- +' Procedure : enableReCreateButton +' Author : Jean-Pierre Imbert +' Date : 15/07/2014 +' Purpose : Enable the ReCreate Button only if all parameters are typed and OK +' +'--------------------------------------------------------------------------------------- +' +Private Sub enableReCreateButton() + ' Enable ReCreate Button only if all parameters are OK + CreateConfigurationButton.Enabled = m_XMLFileOK And m_ConfSelected +End Sub + + +Private Sub XMLFileTextBox_Change() + validateXMLFileTextBox End Sub diff --git a/Source/ConfProd/vtkRecreateConfigurationForm.frx b/Source/ConfProd/vtkRecreateConfigurationForm.frx index 4203b9f..3e29c62 100644 Binary files a/Source/ConfProd/vtkRecreateConfigurationForm.frx and b/Source/ConfProd/vtkRecreateConfigurationForm.frx differ diff --git a/Source/ConfProd/vtkReferenceManager.cls b/Source/ConfProd/vtkReferenceManager.cls index ac4a202..a75190b 100644 --- a/Source/ConfProd/vtkReferenceManager.cls +++ b/Source/ConfProd/vtkReferenceManager.cls @@ -236,14 +236,14 @@ Private Sub initializeReferenceSheet(confCount As Integer, devConf As Integer, r ' Add a reference to the running project (VBAToolKit) Set ref = selfReference() - addOneReference ref + If devConf >= 0 Then addOneReference ref ' Init configuration titles For i = 1 To confCount addConfiguration For j = 1 To referenceCount If devConf >= 0 And devConf <= confCount Then m_referenceSheet.Cells(nbTitleRows + j, nbTitleColumns + i) = "X" - If m_referenceSheet.Cells(nbTitleRows + j, 1) = ref.name And i <> devConf Then m_referenceSheet.Cells(nbTitleRows + j, nbTitleColumns + i) = "" + If i <> devConf And m_referenceSheet.Cells(nbTitleRows + j, 1) = ref.name Then m_referenceSheet.Cells(nbTitleRows + j, nbTitleColumns + i) = "" Next j Next i End Sub @@ -405,3 +405,28 @@ Public Function references(confNumber As Integer) As Collection Err.Raise Number:=VTK_NOTINITIALIZED, Source:="vtkReferenceManager:references", Description:="Impossible to get references from a sheet of a null workbook" End If End Function + +'--------------------------------------------------------------------------------------- +' Sub : setReferenceWihNumber +' Author : Jean-Pierre Imbert +' Date : 14/07/2014 +' Purpose : Set a reference as used or not used for a configuration +' Parameter : - usedRef, true if the reference must be used by the configuration +' - refNumber, the reference number between 1 and refs count +' - confNumber, the configuration number between 1 and conf count +' if the numbers are not legal, VTK_FORBIDDEN_PARAMETER Error is returned +' NOTE : not tested, only used for duplicate configuration manager +'--------------------------------------------------------------------------------------- +' +Public Sub setReferenceWihNumber(usedRef As Boolean, refNumber As Integer, confNumber As Integer) + If refNumber < 1 Or refNumber > referenceCount Then _ + Err.Raise Number:=VTK_FORBIDDEN_PARAMETER, Source:="vtkReferenceManager:setReferenceWithNumber", Description:="Reference number (" & refNumber & ") must be between 1 and " & referenceCount + If confNumber < 1 Or confNumber > configurationCount Then _ + Err.Raise Number:=VTK_FORBIDDEN_PARAMETER, Source:="vtkReferenceManager:setReferenceWithNumber", Description:="Configuration number (" & confNumber & ") must be between 1 and " & configurationCount + If usedRef Then + m_referenceSheet.Cells(nbTitleRows + refNumber, nbTitleColumns + confNumber) = "X" + Else + m_referenceSheet.Cells(nbTitleRows + refNumber, nbTitleColumns + confNumber) = "" + End If +End Sub + diff --git a/Source/ConfProd/vtkWaitForm.frm b/Source/ConfProd/vtkWaitForm.frm new file mode 100644 index 0000000..bac1cf1 --- /dev/null +++ b/Source/ConfProd/vtkWaitForm.frm @@ -0,0 +1,15 @@ +VERSION 5.00 +Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} vtkWaitForm + Caption = "VBAToolKit" + ClientHeight = 675 + ClientLeft = 45 + ClientTop = 435 + ClientWidth = 4770 + OleObjectBlob = "vtkWaitForm.frx":0000 + StartUpPosition = 1 'CenterOwner +End +Attribute VB_Name = "vtkWaitForm" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False diff --git a/Source/ConfProd/vtkWaitForm.frx b/Source/ConfProd/vtkWaitForm.frx new file mode 100644 index 0000000..5c6311e Binary files /dev/null and b/Source/ConfProd/vtkWaitForm.frx differ diff --git a/Source/ConfTest/ThisWorkbook.cls b/Source/ConfTest/ThisWorkbook.cls index 88799b2..ee7b48a 100644 --- a/Source/ConfTest/ThisWorkbook.cls +++ b/Source/ConfTest/ThisWorkbook.cls @@ -44,12 +44,16 @@ Private Sub Workbook_AddinUninstall() End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) + ' If error Exit silently + On Error GoTo M_Error + ' Export and normalize modules VBAToolKit.vtkExportConfiguration ThisWorkbook.VBProject, "VBAToolKit", "VBAToolKit_DEV", onlyModified:=True ' Export as XML VBAToolKit.vtkExportConfigurationsAsXML projectName:="VBAToolKit", filePath:=VBAToolKit.vtkPathOfCurrentProject(ThisWorkbook) & "\" & VBAToolKit.vtkProjectForName("VBAToolKit").XMLConfigurationStandardRelativePath +M_Error: End Sub diff --git a/Source/ConfTest/vtkConfigurationManager10Tester.cls b/Source/ConfTest/vtkConfManagerExcel10Tester.cls similarity index 95% rename from Source/ConfTest/vtkConfigurationManager10Tester.cls rename to Source/ConfTest/vtkConfManagerExcel10Tester.cls index e73b9ac..47e74a3 100644 --- a/Source/ConfTest/vtkConfigurationManager10Tester.cls +++ b/Source/ConfTest/vtkConfManagerExcel10Tester.cls @@ -2,7 +2,7 @@ VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END -Attribute VB_Name = "vtkConfigurationManager10Tester" +Attribute VB_Name = "vtkConfManagerExcel10Tester" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -39,6 +39,7 @@ Private mAssert As IAssert Private existingWorkbook As Workbook ' Existing Workbook opened for each test Private Const existingWorkbookNameForTest As String = "WorkBookForConfigurationsTests10.xlsm" Private existingConfManager As vtkConfigurationManager ' Configuration Manager for the existing workbook +Private existingConfManagerExcel As vtkConfigurationManagerExcel ' Excel Configuration Manager for the existing workbook Private Const existingProjectName As String = "ExistingProject" Private existingWorkbookName As String @@ -61,6 +62,7 @@ Private Sub ITestCase_SetUp(Assert As IAssert) Set existingWorkbook = getTestFileFromTemplate(fileName:=existingWorkbookNameForTest, destinationName:=existingProjectName & "_DEV.xlsm", openExcel:=True) existingWorkbookName = existingWorkbook.name Set existingConfManager = vtkConfigurationManagerForProject(existingProjectName) + Set existingConfManagerExcel = existingConfManager End Sub Private Sub ITestCase_TearDown() @@ -77,7 +79,7 @@ End Sub Public Sub TestConfigurationSheetExistsInExistingWorkbook() ' Verify that the configuration sheet presence is detected in existing workbook ' using a fresh configuration Manager (with no default sheet initialized) - Dim cm As New vtkConfigurationManager + Dim cm As New vtkConfigurationManagerExcel mAssert.Should cm.isConfigurationInitializedForWorkbook(ExcelName:=existingWorkbookName), "The Configuration sheet must exist in existing workbook" End Sub @@ -88,13 +90,13 @@ Public Sub TestConfigurationSheetRetrievalForExistingProject() Set ws = existingWorkbook.Sheets("vtkConfigurations") mAssert.Equals Err, 0, "A configuration manager must be accessible in an existing project" On Error GoTo 0 - mAssert.Should existingWorkbook.Sheets("vtkConfigurations") Is existingConfManager.configurationSheet, "The configurationSheet property of the conf manager must be equal to the configuration sheet of the workbook" + mAssert.Should existingWorkbook.Sheets("vtkConfigurations") Is existingConfManagerExcel.configurationSheet, "The configurationSheet property of the conf manager must be equal to the configuration sheet of the workbook" End Sub Public Sub TestConfigurationSheetFormatForExistingProjet() ' Verify the retrieved configuration sheet from an existing project Dim ws As Worksheet - Set ws = existingConfManager.configurationSheet + Set ws = existingConfManagerExcel.configurationSheet mAssert.Equals ws.Range("A1"), "vtkConfigurations v1.0", "Expected identification of the configuration sheet" mAssert.Equals ws.Range("A2"), "Module Name", "Expected Title for Modules column" mAssert.Equals ws.Range("B1"), existingProjectName, "Expected Title for main project column" @@ -138,7 +140,7 @@ Public Sub Test_AddConfigurationInExistingProject_Cells() Dim n As Integer n = existingConfManager.addConfiguration("NewConfiguration", "ConfigurationPath") - Set ws = existingConfManager.configurationSheet + Set ws = existingConfManagerExcel.configurationSheet mAssert.Equals ws.Range("A1"), "vtkConfigurations v1.0", "Expected identification of the configuration sheet" mAssert.Equals ws.Range("A2"), "Module Name", "Expected Title for Modules column" mAssert.Equals ws.Range("B1"), existingProjectName, "Expected Title for main project column" diff --git a/Source/ConfTest/vtkConfigurationManager11Tester.cls b/Source/ConfTest/vtkConfManagerExcel11Tester.cls similarity index 85% rename from Source/ConfTest/vtkConfigurationManager11Tester.cls rename to Source/ConfTest/vtkConfManagerExcel11Tester.cls index be77ea1..56895df 100644 --- a/Source/ConfTest/vtkConfigurationManager11Tester.cls +++ b/Source/ConfTest/vtkConfManagerExcel11Tester.cls @@ -2,7 +2,7 @@ VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END -Attribute VB_Name = "vtkConfigurationManager11Tester" +Attribute VB_Name = "vtkConfManagerExcel11Tester" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -39,11 +39,13 @@ Private mAssert As IAssert Private newWorkbook As Workbook ' New Workbook created for each test Private newWorkbookName As String Private newConfManager As vtkConfigurationManager ' Configuration Manager for the new workbook +Private newConfManagerExcel As vtkConfigurationManagerExcel ' For specialized test for Excel Conf Manager Private newProjectName As String Private existingWorkbook As Workbook ' Existing Workbook opened for each test Private Const existingWorkbookNameForTest As String = "WorkBookForConfigurationsTests.xlsm" Private existingConfManager As vtkConfigurationManager ' Configuration Manager for the existing workbook +Private existingConfManagerExcel As vtkConfigurationManagerExcel ' For specialized test for Excel Conf Manager Private Const existingProjectName As String = "ExistingProject" Private existingWorkbookName As String @@ -83,16 +85,19 @@ Private Sub ITestCase_SetUp(Assert As IAssert) newWorkbookName = newWorkbook.name newProjectName = newWorkbook.VBProject.name Set newConfManager = vtkConfigurationManagerForProject(newProjectName) + Set newConfManagerExcel = newConfManager Set existingWorkbook = getTestFileFromTemplate(fileName:=existingWorkbookNameForTest, destinationName:=existingProjectName & "_DEV.xlsm", openExcel:=True) existingWorkbookName = existingWorkbook.name Set existingConfManager = vtkConfigurationManagerForProject(existingProjectName) + Set existingConfManagerExcel = existingConfManager End Sub Private Sub ITestCase_TearDown() vtkCloseAndKillWorkbook Wb:=newWorkbook ' close the new Excel project vtkCloseAndKillWorkbook Wb:=existingWorkbook ' close the existing Excel project vtkResetConfigurationManagers ' reset all configuration managers + VBAToolKit.resetTestFolder ' reset the test folder End Sub Public Sub Test_PropertyName_DefaultGet() @@ -106,21 +111,21 @@ Public Sub Test_PropertyName_DefaultLet() ' - In fact there is no need to run the test, just to compile it ' - both existing project and new project worbooks must be opened mAssert.Equals existingConfManager, "ExistingProject", "The name property of existingConf before modification" - existingConfManager = "NewProject" + existingConfManagerExcel = "NewProject" mAssert.Equals existingConfManager, "NewProject", "The name property of existingConf after modification" End Sub Public Sub TestConfigurationSheetExistsInExistingWorkbook() ' Verify that the configuration sheet presence is detected in existing workbook ' using a fresh configuration Manager (with no default sheet initialized) - Dim cm As New vtkConfigurationManager + Dim cm As New vtkConfigurationManagerExcel mAssert.Should cm.isConfigurationInitializedForWorkbook(ExcelName:=existingWorkbookName), "The Configuration sheet must exist in existing workbook" End Sub Public Sub TestConfigurationSheetDoesntExistInNewWorkbook() ' Verify that the configuration sheet missing is created in new workbook ' using a fresh configuration Manager (with no default sheet initialized) - Dim cm As New vtkConfigurationManager, Wb As Workbook, wbFullName As String + Dim cm As New vtkConfigurationManagerExcel, Wb As Workbook, wbFullName As String Set Wb = vtkCreateExcelWorkbookForTestWithProjectName("NewWorkbook") ' create a fresh new Excel workbook wbFullName = Wb.FullName mAssert.Should Not cm.isConfigurationInitializedForWorkbook(ExcelName:=Wb.name), "The Configuration sheet must not exist in new workbook" @@ -135,7 +140,7 @@ Public Sub TestConfigurationSheetCreationForNewProject() Set ws = newWorkbook.Sheets("vtkConfigurations") mAssert.Equals Err, 0, "A configuration manager must create a Configuration sheet" On Error GoTo 0 - mAssert.Should newWorkbook.Sheets("vtkConfigurations") Is newConfManager.configurationSheet, "The configurationSheet property of the conf manager must be equal to the configuration sheet of the workbook" + mAssert.Should newWorkbook.Sheets("vtkConfigurations") Is newConfManagerExcel.configurationSheet, "The configurationSheet property of the conf manager must be equal to the configuration sheet of the workbook" End Sub Public Sub TestConfigurationSheetRetrievalForExistingProject() @@ -145,13 +150,13 @@ Public Sub TestConfigurationSheetRetrievalForExistingProject() Set ws = existingWorkbook.Sheets("vtkConfigurations") mAssert.Equals Err, 0, "A configuration manager must be accessible in an existing project" On Error GoTo 0 - mAssert.Should existingWorkbook.Sheets("vtkConfigurations") Is existingConfManager.configurationSheet, "The configurationSheet property of the conf manager must be equal to the configuration sheet of the workbook" + mAssert.Should existingWorkbook.Sheets("vtkConfigurations") Is existingConfManagerExcel.configurationSheet, "The configurationSheet property of the conf manager must be equal to the configuration sheet of the workbook" End Sub Public Sub TestConfigurationSheetFormatForNewProjet() ' Verify the newly created configuration sheet of a new project Dim ws As Worksheet - Set ws = newConfManager.configurationSheet + Set ws = newConfManagerExcel.configurationSheet mAssert.Equals ws.Range("A1"), "vtkConfigurations v1.1", "Expected identification of the configuration sheet" mAssert.Equals ws.Range("A2"), "", "Expected Title for Modules column" mAssert.Equals ws.Range("A3"), "Path, template, name and comment", "Expected Title for Configurations columns" @@ -172,7 +177,7 @@ End Sub Public Sub TestConfigurationSheetFormatForExistingProjet() ' Verify the retrieved configuration sheet from an existing project Dim ws As Worksheet - Set ws = existingConfManager.configurationSheet + Set ws = existingConfManagerExcel.configurationSheet mAssert.Equals ws.Range("A1"), "vtkConfigurations v1.1", "Expected identification of the configuration sheet" mAssert.Equals ws.Range("A2"), "", "Expected empty cell" mAssert.Equals ws.Range("A3"), "Path, template, name and comment", "Expected Title for Configurations columns" @@ -185,7 +190,7 @@ Public Sub TestConfigurationSheetFormatForExistingProjet() mAssert.Equals ws.Range("B5"), "Existing project for various tests of VBAToolKit", "Expected Comment for main workbook" mAssert.Equals ws.Range("C1"), existingProjectName & "_DEV", "Expected Title for development project column" mAssert.Equals ws.Range("C2"), "Project\ExistingProject_DEV.xlsm", "Expected related Path for development workbook" - mAssert.Equals ws.Range("C3"), "", "Expected Template path for development workbook" + mAssert.Equals ws.Range("C3"), "Templates\ExistingProjectTemplate.xlsm", "Expected Template path for development workbook" mAssert.Equals ws.Range("C4"), "", "Expected empty projectName for development workbook" mAssert.Equals ws.Range("C5"), "Existing project for development for various tests of VBAToolKit", "Expected Comment for development workbook" End Sub @@ -236,7 +241,7 @@ Public Sub Test_AddConfigurationInExistingProject_Cells() Dim n As Integer n = existingConfManager.addConfiguration("NewConfiguration", "ConfigurationPath", comment:="New comment") - Set ws = existingConfManager.configurationSheet + Set ws = existingConfManagerExcel.configurationSheet mAssert.Equals ws.Range("A1"), "vtkConfigurations v1.1", "Expected identification of the configuration sheet" mAssert.Equals ws.Range("A2"), "", "Expected Title for Modules column" mAssert.Equals ws.Range("A3"), "Path, template, name and comment", "Expected Title for Configurations columns" @@ -249,7 +254,7 @@ Public Sub Test_AddConfigurationInExistingProject_Cells() mAssert.Equals ws.Range("B5"), "Existing project for various tests of VBAToolKit", "Expected Comment for main workbook" mAssert.Equals ws.Range("C1"), existingProjectName & "_DEV", "Expected Title for development project column" mAssert.Equals ws.Range("C2"), "Project\ExistingProject_DEV.xlsm", "Expected related Path for new development workbook" - mAssert.Equals ws.Range("C3"), "", "Expected Template path for development workbook" + mAssert.Equals ws.Range("C3"), "Templates\ExistingProjectTemplate.xlsm", "Expected Template path for development workbook" mAssert.Equals ws.Range("C4"), "", "Expected empty projectName for development workbook" mAssert.Equals ws.Range("C5"), "Existing project for development for various tests of VBAToolKit", "Expected Comment for development workbook" mAssert.Equals ws.Range("D1"), "NewConfiguration", "Expected Title for new configuration column" @@ -461,7 +466,7 @@ End Sub Public Sub TestConfigurationSheetFormatAfterConversion() ' Verify the newly converted configuration sheet of a new project - Dim ws As Worksheet, workbookV10 As Workbook, confManagerV10 As vtkConfigurationManager + Dim ws As Worksheet, workbookV10 As Workbook, confManagerV10 As vtkConfigurationManagerExcel Set workbookV10 = getTestFileFromTemplate(fileName:=workbookNameWithConfigurationV10, destinationName:="ProjectV10_DEV.xlsm", openExcel:=True) Set confManagerV10 = vtkConfigurationManagerForProject("ProjectV10") @@ -496,9 +501,9 @@ Public Sub TestConfigurationSheetFormatUpToDateConversion() ' Verify that an up to date configuration sheet is not modified when converted Dim ws As Worksheet - existingConfManager.updateConfigurationSheetFormat + existingConfManagerExcel.updateConfigurationSheetFormat - Set ws = existingConfManager.configurationSheet + Set ws = existingConfManagerExcel.configurationSheet mAssert.Equals ws.Range("A1"), "vtkConfigurations v1.1", "Expected identification of the configuration sheet" mAssert.Equals ws.Range("A2"), "", "Expected Title for Modules column" mAssert.Equals ws.Range("A3"), "Path, template, name and comment", "Expected Title for Configurations columns" @@ -511,7 +516,7 @@ Public Sub TestConfigurationSheetFormatUpToDateConversion() mAssert.Equals ws.Range("B5"), "Existing project for various tests of VBAToolKit", "Expected Comment for existing workbook" mAssert.Equals ws.Range("C1"), "ExistingProject_DEV", "Expected Title for development project column" mAssert.Equals ws.Range("C2"), "Project\ExistingProject_DEV.xlsm", "Expected related Path for new development workbook" - mAssert.Equals ws.Range("C3"), "", "Expected Template path for development workbook" + mAssert.Equals ws.Range("C3"), "Templates\ExistingProjectTemplate.xlsm", "Expected Template path for development workbook" mAssert.Equals ws.Range("C4"), "", "Expected Project name for existing workbook" mAssert.Equals ws.Range("C5"), "Existing project for development for various tests of VBAToolKit", "Expected Comment for existing workbook" @@ -563,6 +568,99 @@ Public Sub TestGetAllReferencesFromExistingWorkbook() On Error GoTo 0 End Sub +Public Sub Test_Duplicate_InitializedConfManager() +' Check the raise of an error when conf manager already initialized + Dim Wb As Workbook, cm As vtkConfigurationManager, cmE As vtkConfigurationManagerExcel + Dim cmX As vtkConfigurationManagerXML, testFilePath As String, testFileName As String + + Set Wb = vtkCreateExcelWorkbookForTestWithProjectName("DupProject") ' create an Excel project + testFileName = "ExistingProject.xml" + testFilePath = VBAToolKit.vtkTestPath & "\" & testFileName + getTestFileFromTemplate fileName:="XMLForConfigurationsTests.xml", destinationName:=testFileName, openExcel:=False + Set cm = New vtkConfigurationManagerXML + Set cmX = cm + cmX.init testFilePath ' create and initialize a XML conf manager to duplicate + + On Error Resume Next + Set cmE = existingConfManager + cmE.duplicate Wb:=wb, cm:=cm + mAssert.Equals Err.Number, VTK_ALREADY_INITIALIZED, "Error raised by duplicate method" + On Error GoTo 0 + + vtkCloseAndKillWorkbook Wb:=Wb ' close the new Excel project +End Sub + +Public Sub Test_Duplicate_WorkbookNotOpened() +' Check the raise of an error when workbook is not open + Dim cmFrom As vtkConfigurationManager + Dim cmE As vtkConfigurationManagerExcel, cmX As vtkConfigurationManagerXML + Dim testFilePath As String, testFileName As String + + testFileName = "ExistingProject.xml" + testFilePath = VBAToolKit.vtkTestPath & "\" & testFileName + getTestFileFromTemplate fileName:="XMLForConfigurationsTests.xml", destinationName:=testFileName, openExcel:=False + Set cmFrom = New vtkConfigurationManagerXML + Set cmX = cmFrom + cmX.init testFilePath ' create and initialize a XML conf manager to duplicate + + On Error Resume Next + Set cmE = New vtkConfigurationManagerExcel + cmE.duplicate Wb:=Nothing, cm:=cmFrom + mAssert.Equals Err.Number, VTK_WORKBOOK_NOTOPEN, "Error raised by duplicate method" + On Error GoTo 0 +End Sub + +Public Sub Test_Duplicate_InitializedWorkbook() +' Check the raise of an error when workbook already initialized + Dim cmFrom As vtkConfigurationManager + Dim cmE As vtkConfigurationManagerExcel, cmX As vtkConfigurationManagerXML + Dim testFilePath As String, testFileName As String + + testFileName = "ExistingProject.xml" + testFilePath = VBAToolKit.vtkTestPath & "\" & testFileName + getTestFileFromTemplate fileName:="XMLForConfigurationsTests.xml", destinationName:=testFileName, openExcel:=False + Set cmFrom = New vtkConfigurationManagerXML + Set cmX = cmFrom + cmX.init testFilePath ' create and initialize a XML conf manager to duplicate + + On Error Resume Next + Set cmE = New vtkConfigurationManagerExcel + cmE.duplicate Wb:=existingWorkbook, cm:=cmFrom + mAssert.Equals Err.Number, VTK_ALREADY_INITIALIZED, "Error raised by duplicate method" + On Error GoTo 0 +End Sub + +Public Sub Test_Duplicate_Nominal() +' Check the behavior of duplicate method in nominal case + Dim Wb As Workbook, cm As vtkConfigurationManager, cmE As vtkConfigurationManagerExcel + Dim cmX As vtkConfigurationManagerXML, testFilePath As String, testFileName As String, i As Integer, j As Integer + Dim refE As vtkReference, refX As vtkReference + + Set Wb = vtkCreateExcelWorkbookForTestWithProjectName("DupProject") ' create an Excel project + testFileName = "ExistingProject.xml" + testFilePath = VBAToolKit.vtkTestPath & "\" & testFileName + getTestFileFromTemplate fileName:="XMLForConfigurationsTests.xml", destinationName:=testFileName, openExcel:=False + Set cm = New vtkConfigurationManagerXML + Set cmX = cm + cmX.init testFilePath ' create and initialize a XML conf manager to duplicate + + On Error GoTo M_Error + Set cmE = New vtkConfigurationManagerExcel + cmE.duplicate Wb:=wb, cm:=cm + + ' Check configuration manager parameters + mAssert.Should Wb.Worksheets("vtkConfigurations") Is cmE.configurationSheet, "Configuration sheet of duplicated conf manager" + vtkCompareConfManagers mAssert, expectedConf:=cm, actualConf:=cmE + + On Error GoTo 0 + GoTo M_Exit + +M_Error: + mAssert.Should False, "Unexpected error (" & Err.Number & ") : " & Err.Description +M_Exit: + vtkCloseAndKillWorkbook Wb:=Wb ' close the new Excel project +End Sub + Private Function ITest_Suite() As TestSuite Set ITest_Suite = New TestSuite ITest_Suite.AddTest ITest_Manager.ClassName, "Test_PropertyName_DefaultGet" @@ -598,6 +696,10 @@ Private Function ITest_Suite() As TestSuite ITest_Suite.AddTest ITest_Manager.ClassName, "TestConfigurationSheetFormatUpToDateConversion" ITest_Suite.AddTest ITest_Manager.ClassName, "TestGetAllReferencesFromNewWorkbook" ITest_Suite.AddTest ITest_Manager.ClassName, "TestGetAllReferencesFromExistingWorkbook" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_Duplicate_InitializedConfManager" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_Duplicate_WorkbookNotOpened" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_Duplicate_InitializedWorkbook" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_Duplicate_Nominal" End Function Private Sub ITestCase_RunTest() @@ -635,6 +737,10 @@ Private Sub ITestCase_RunTest() Case "TestConfigurationSheetFormatUpToDateConversion": TestConfigurationSheetFormatUpToDateConversion Case "TestGetAllReferencesFromNewWorkbook": TestGetAllReferencesFromNewWorkbook Case "TestGetAllReferencesFromExistingWorkbook": TestGetAllReferencesFromExistingWorkbook + Case "Test_Duplicate_InitializedConfManager": Test_Duplicate_InitializedConfManager + Case "Test_Duplicate_WorkbookNotOpened": Test_Duplicate_WorkbookNotOpened + Case "Test_Duplicate_InitializedWorkbook": Test_Duplicate_InitializedWorkbook + Case "Test_Duplicate_Nominal": Test_Duplicate_Nominal Case Else: mAssert.Should False, "Invalid test name: " & mManager.methodName End Select End Sub diff --git a/Source/ConfTest/vtkConfManagerXML20Tester.cls b/Source/ConfTest/vtkConfManagerXML20Tester.cls new file mode 100644 index 0000000..5038788 --- /dev/null +++ b/Source/ConfTest/vtkConfManagerXML20Tester.cls @@ -0,0 +1,398 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "vtkConfManagerXML20Tester" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +'--------------------------------------------------------------------------------------- +' Module : vtkConfManagerXML20Tester +' Author : Jean-Pierre Imbert +' Date : 06/07/2014 +' Purpose : Test the vtkConfigurationManagerXML class +' with vtkConfigurations XML version 2.0 +' +' Copyright 2014 Skwal-Soft (http://skwalsoft.com) +' +' Licensed under the Apache License, Version 2.0 (the "License"); +' you may not use this file except in compliance with the License. +' You may obtain a copy of the License at +' +' http://www.apache.org/licenses/LICENSE-2.0 +' +' Unless required by applicable law or agreed to in writing, software +' distributed under the License is distributed on an "AS IS" BASIS, +' WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +' See the License for the specific language governing permissions and +' limitations under the License. +'--------------------------------------------------------------------------------------- + +Option Explicit +Implements ITest +Implements ITestCase + +Private mManager As TestCaseManager +Private mAssert As IAssert + +Private Const existingXMLNameForTest As String = "XMLForConfigurationsTests.xml" +Private existingConfManager As vtkConfigurationManager ' Configuration Manager for the existing workbook +Private Const existingProjectName As String = "ExistingProject" + +Private Sub Class_Initialize() + Set mManager = New TestCaseManager +End Sub + +Private Property Get ITestCase_Manager() As TestCaseManager + Set ITestCase_Manager = mManager +End Property + +Private Property Get ITest_Manager() As ITestManager + Set ITest_Manager = mManager +End Property + +Private Sub ITestCase_SetUp(Assert As IAssert) + Dim cmE As vtkConfigurationManagerXML, testFilePath As String, testFileName As String + Set mAssert = Assert + + testFileName = existingProjectName & ".xml" + testFilePath = VBAToolKit.vtkTestPath & "\" & testFileName + getTestFileFromTemplate fileName:=existingXMLNameForTest, destinationName:=testFileName, openExcel:=False + Set existingConfManager = New vtkConfigurationManagerXML + Set cmE = existingConfManager + cmE.init testFilePath +End Sub + +Private Sub ITestCase_TearDown() + VBAToolKit.resetTestFolder +End Sub + +Public Sub Test_Init_FileNotFound() + ' Verify that the proper error is raised in case of file not found + Dim cm As New vtkConfigurationManagerXML + On Error Resume Next + cm.init "C:\NoFolder\NoFile.xml" + mAssert.Equals Err.Number, VTK_WRONG_FILE_PATH, "Error returned when init the XML conf manager" + On Error GoTo 0 +End Sub + +Public Sub Test_Init_BadXMLFile() + ' Verify that the proper error is raised in case of bad XML File + Dim cm As New vtkConfigurationManagerXML, filePath As String + filePath = VBAToolKit.vtkTestPath & "\EmptyXMLFile.xml" + Dim fso As New FileSystemObject + fso.CreateTextFile filePath + On Error Resume Next + cm.init filePath + mAssert.Equals Err.Number, VTK_INVALID_XML_FILE, "Error returned when init the XML conf manager" + On Error GoTo 0 +End Sub + +Public Sub Test_Init_ObsoleteXMLFile() + ' Verify that the proper error is raised in case of obsolete XML File + Dim fileName As String, filePath As String, cm As New vtkConfigurationManagerXML + fileName = "ExistingProject.xml" + filePath = VBAToolKit.vtkTestPath & "\" & fileName + getTestFileFromTemplate fileName:="EmptyXMLForConfigurationsTests.xml", destinationName:=fileName, openExcel:=False + On Error Resume Next + cm.init filePath + mAssert.Equals Err.Number, VTK_OBSOLETE_CONFIGURATION_SHEET, "Error returned when init the XML conf manager" + On Error GoTo 0 +End Sub + +Public Sub Test_ForbiddenSetterCalls() + ' Verify that a call to a setter raise the proper error + On Error Resume Next + existingConfManager.addConfiguration "NewConfiguration", "ConfigurationPath" + mAssert.Equals Err.Number, VTK_READONLY_FILE, "Error returned when trying to call addConfiguration on XML Conf File" + Err.Number = 0 + existingConfManager.setConfigurationPathWithNumber n:=0, path:="Path0" + mAssert.Equals Err.Number, VTK_READONLY_FILE, "Error returned when trying to call setConfigurationPathWithNumber on XML Conf File" + Err.Number = 0 + existingConfManager.setConfigurationPath configuration:="InexistantConfiguration", path:="Path0" + mAssert.Equals Err.Number, VTK_READONLY_FILE, "Error returned when trying to call setConfigurationPath on XML Conf File" + Err.Number = 0 + existingConfManager.setConfigurationProjectNameWithNumber n:=1, projectName:="NewName" + mAssert.Equals Err.Number, VTK_READONLY_FILE, "Error returned when trying to call setConfigurationProjectNameWithNumber on XML Conf File" + Err.Number = 0 + existingConfManager.setConfigurationCommentWithNumber n:=1, comment:="NewComment" + mAssert.Equals Err.Number, VTK_READONLY_FILE, "Error returned when trying to call setConfigurationCommentWithNumber on XML Conf File" + Err.Number = 0 + existingConfManager.setConfigurationTemplateWithNumber n:=1, template:="NewTemplate" + mAssert.Equals Err.Number, VTK_READONLY_FILE, "Error returned when trying to call setConfigurationTemplateWithNumber on XML Conf File" + Err.Number = 0 + existingConfManager.addModule module:="NewModule1" + mAssert.Equals Err.Number, VTK_READONLY_FILE, "Error returned when trying to call addModule on XML Conf File" + Err.Number = 0 + existingConfManager.setModulePathWithNumber path:="NewPath", numModule:=1, numConfiguration:=1 + mAssert.Equals Err.Number, VTK_READONLY_FILE, "Error returned when trying to call setModulePathWithNumber on XML Conf File" + Err.Number = 0 + On Error GoTo 0 +End Sub + +Public Sub Test_PropertyName_DefaultGet() + ' Verify that the Property Name is the Default property for vtkConfigurationManager + ' - In fact there is no need to run the test, just to compile it + mAssert.Equals existingConfManager, "ExistingProject", "The name property must be the default one for vtkConfigurationManager" +End Sub + +Public Sub TestGetConfigurationsFromExistingProject() +' Verify the list of the configurations of an existing project + mAssert.Equals existingConfManager.configurationCount, 2, "There must be two configurations in the existing template project" + mAssert.Equals existingConfManager.configuration(0), "", "Inexistant configuration number 0" + mAssert.Equals existingConfManager.configuration(1), existingProjectName, "Name of the first configuration" + mAssert.Equals existingConfManager.configuration(2), existingProjectName & "_DEV", "Name of the second configuration" + mAssert.Equals existingConfManager.configuration(3), "", "Inexistant configuration number 3" + mAssert.Equals existingConfManager.configuration(-23), "", "Inexistant configuration number -23" + mAssert.Equals existingConfManager.configuration(150), "", "Inexistant configuration number 150" +End Sub + +Public Sub TestGetConfigurationPathWithNumberFromExistingProject() +' Verify the capability to get the configuration path by number + mAssert.Equals existingConfManager.getConfigurationPathWithNumber(0), "", "Inexistant configuration number 0" + mAssert.Equals existingConfManager.getConfigurationPathWithNumber(1), "Delivery\ExistingProject.xlsm", "Path of first configuration given by number" + mAssert.Equals existingConfManager.getConfigurationPathWithNumber(2), "Project\ExistingProject_DEV.xlsm", "Path of second configuration given by number" + mAssert.Equals existingConfManager.getConfigurationPathWithNumber(3), "", "Inexistant configuration number 3" +End Sub + +Public Sub TestGetConfigurationProjectNameWithNumberFromExistingProject() +' Verify the capability to get the configuration project name by number + mAssert.Equals existingConfManager.getConfigurationProjectNameWithNumber(0), "", "Inexistant configuration number 0" + mAssert.Equals existingConfManager.getConfigurationProjectNameWithNumber(1), "ExistingProjectName", "Project Name of first configuration given by number" + mAssert.Equals existingConfManager.getConfigurationProjectNameWithNumber(2), "ExistingProject_DEV", "Project Name of second configuration given by number" + mAssert.Equals existingConfManager.getConfigurationProjectNameWithNumber(3), "", "Inexistant configuration number 3" +End Sub + +Public Sub TestGetConfigurationCommentWithNumberFromExistingProject() +' Verify the capability to get the configuration comment by number + mAssert.Equals existingConfManager.getConfigurationCommentWithNumber(0), "", "Inexistant configuration number 0" + mAssert.Equals existingConfManager.getConfigurationCommentWithNumber(1), "Existing project for various tests of VBAToolKit", "Comment of first configuration given by number" + mAssert.Equals existingConfManager.getConfigurationCommentWithNumber(2), "Existing project for development for various tests of VBAToolKit", "Comment of second configuration given by number" + mAssert.Equals existingConfManager.getConfigurationCommentWithNumber(3), "", "Inexistant configuration number 3" +End Sub + +Public Sub TestGetConfigurationTemplateWithNumberFromExistingProject() +' Verify the capability to get the configuration template path by number + mAssert.Equals existingConfManager.getConfigurationTemplateWithNumber(0), "", "Inexistant configuration number 0" + mAssert.Equals existingConfManager.getConfigurationTemplateWithNumber(1), "", "Template path of first configuration given by number" + mAssert.Equals existingConfManager.getConfigurationTemplateWithNumber(2), "Templates\ExistingProjectTemplate.xlsm", "Template path of second configuration given by number" + mAssert.Equals existingConfManager.getConfigurationTemplateWithNumber(3), "", "Inexistant configuration number 3" +End Sub + +Public Sub TestGetConfigurationNumbersFromExistingProject() +' Verify the capability to get the number of a configuration + mAssert.Equals existingConfManager.configurationCount, 2, "There must be two configurations in a new project" + mAssert.Equals existingConfManager.getConfigurationNumber(existingProjectName), 1, "Number of the main configuration" + mAssert.Equals existingConfManager.getConfigurationNumber(existingProjectName & "_DEV"), 2, "Number of the Development configuration" + mAssert.Equals existingConfManager.getConfigurationNumber("InexistantConfiguration"), 0, "Inexistant configuration" +End Sub + +Public Sub TestGetConfigurationPathFromExistingProject() +' Verify the capability to get a configutaion path given the configuration name + mAssert.Equals existingConfManager.getConfigurationPath(existingProjectName), "Delivery\ExistingProject.xlsm", "Path of the main configuration" + mAssert.Equals existingConfManager.getConfigurationPath(existingProjectName & "_DEV"), "Project\ExistingProject_DEV.xlsm", "Path of the Development configuration" + mAssert.Equals existingConfManager.getConfigurationPath("InexistantConfiguration"), "", "Inexistant configuration" +End Sub + +Public Sub TestGetModulesFromExistingProject() +' Verify the capability to retrieve the list of Modules from an existing project + mAssert.Equals existingConfManager.moduleCount, 5, "There must be five configurations in the existing project" + mAssert.Equals existingConfManager.module(0), "", "Inexistant module number 0" + mAssert.Equals existingConfManager.module(1), "Module1", "Name of the first module" + mAssert.Equals existingConfManager.module(2), "Module2", "Name of the second module" + mAssert.Equals existingConfManager.module(3), "Module3", "Name of the third module" + mAssert.Equals existingConfManager.module(4), "Module4", "Name of the fourth module" + mAssert.Equals existingConfManager.module(5), "Module5", "Name of the fifth module" + mAssert.Equals existingConfManager.module(6), "", "Inexistant module number 6" + mAssert.Equals existingConfManager.module(-23), "", "Inexistant module number -23" + mAssert.Equals existingConfManager.module(150), "", "Inexistant module number 150" +End Sub + +Public Sub TestGetModuleNumbersFromExistingProject() +' Verify the capability to get the number of a configuration + mAssert.Equals existingConfManager.getModuleNumber("Module0"), 0, "Inexistant module" + mAssert.Equals existingConfManager.getModuleNumber("Module1"), 1, "First Module" + mAssert.Equals existingConfManager.getModuleNumber("Module2"), 2, "Second Module" + mAssert.Equals existingConfManager.getModuleNumber("Module3"), 3, "Third module" + mAssert.Equals existingConfManager.getModuleNumber("Module4"), 4, "Fourth module" + mAssert.Equals existingConfManager.getModuleNumber("Module5"), 5, "Fifth module" + mAssert.Equals existingConfManager.getModuleNumber("InexistantModule"), 0, "Inexistant module" +End Sub + +Public Sub TestGetModulePathWithNumberFromExistingProject() +' Verify the capability to get the module path by number + mAssert.Equals existingConfManager.getModulePathWithNumber(numModule:=0, numConfiguration:=2), "", "Inexistant module path number 0,2" + mAssert.Equals existingConfManager.getModulePathWithNumber(numModule:=3, numConfiguration:=3), "", "Inexistant module path number 3,3" + mAssert.Equals existingConfManager.getModulePathWithNumber(numModule:=1, numConfiguration:=1), "Path1Module1", "Module path number 1,1" + mAssert.Equals existingConfManager.getModulePathWithNumber(numModule:=1, numConfiguration:=2), "", "Module path number 1,2" + mAssert.Equals existingConfManager.getModulePathWithNumber(numModule:=2, numConfiguration:=1), "", "Module path number 2,1" + mAssert.Equals existingConfManager.getModulePathWithNumber(numModule:=2, numConfiguration:=2), "Path2Module2", "Module path number 2,2" + mAssert.Equals existingConfManager.getModulePathWithNumber(numModule:=3, numConfiguration:=1), "", "Module path number 3,1" + mAssert.Equals existingConfManager.getModulePathWithNumber(numModule:=3, numConfiguration:=2), "", "Module path number 3,2" + mAssert.Equals existingConfManager.getModulePathWithNumber(numModule:=4, numConfiguration:=1), "Path1Module4", "Module path number 4,1" + mAssert.Equals existingConfManager.getModulePathWithNumber(numModule:=4, numConfiguration:=2), "Path2Module4", "Module path number 4,2" + mAssert.Equals existingConfManager.getModulePathWithNumber(numModule:=5, numConfiguration:=1), "", "Module path number 5,1" + mAssert.Equals existingConfManager.getModulePathWithNumber(numModule:=5, numConfiguration:=2), "Path2Module5", "Module path number 5,2" +End Sub + +Public Sub TestModulesFromExistingProject() +' Verify the capability to get the modules list + Dim n As Integer + On Error GoTo M_Error + mAssert.Equals existingConfManager.modules.count, 5, "Number of modules in the existing project" + For n = 1 To n + mAssert.Should existingConfManager.modules(n).parent Is existingConfManager, "Parent of the vtkModule " & n & " of existing project" + mAssert.Equals existingConfManager.modules(n).Number, n, "The number of vtkModule " & n & " of existing project" + mAssert.Equals existingConfManager.modules(n).id, "m" & n, "Expected ID for module " & n + mAssert.Equals existingConfManager.modules(n).name, "Module" & n, "Name of the module " & n & " get by number" + mAssert.Equals existingConfManager.modules("Module" & n).Number, n, "Number of the module " & n & " get by name" + Next n + On Error GoTo 0 + Exit Sub +M_Error: + mAssert.Should False, "Unexpected error (" & Err.Number & ") : " & Err.Description +End Sub + +Public Sub TestConfigurationsCollectionFromExistingProject() +' Verify the behavior of the configurations function of Conf manager + On Error GoTo M_Error + mAssert.Equals existingConfManager.configurations.count, 2, "Number of configurations in the existing project" + ' Check the first configuration + mAssert.Should existingConfManager.configurations(1).parent Is existingConfManager, "Parent of the first configuration" + mAssert.Equals existingConfManager.configurations(1).Number, 1, "Number of the first configuration" + mAssert.Equals existingConfManager.configurations(1).id, "c1", "Expected ID for the first vtkConfiguration" + mAssert.Should Not existingConfManager.configurations(1).isDEV, "The first configuration is expected not to be DEV" + mAssert.Equals existingConfManager.configurations(1).name, "ExistingProject", "Name of the configuration for the first vtkConfiguration" + mAssert.Equals existingConfManager.configurations("ExistingProject").name, "ExistingProject", "Name of the configuration for the first vtkConfiguration" + mAssert.Equals existingConfManager.configurations(1).comment, "Existing project for various tests of VBAToolKit", "Comment got by number of the first configuration" + mAssert.Equals existingConfManager.configurations("ExistingProject").comment, "Existing project for various tests of VBAToolKit", "Comment got by name of the first configuration" + mAssert.Equals existingConfManager.configurations(1).template, "", "Template got by number of the first configuration" + mAssert.Equals existingConfManager.configurations("ExistingProject").template, "", "Template got by name of the first configuration" + mAssert.Equals existingConfManager.configurations(1).projectName, "ExistingProjectName", "Project Name (Title) got by number of the first configuration" + mAssert.Equals existingConfManager.configurations("ExistingProject").projectName, "ExistingProjectName", "Project Name (Title) got by name of the first configuration" + ' Check the second configuration + mAssert.Should existingConfManager.configurations(2).parent Is existingConfManager, "Parent of the second configuration" + mAssert.Equals existingConfManager.configurations(2).Number, 2, "Number of the second configuration" + mAssert.Equals existingConfManager.configurations(2).id, "c2", "Expected ID for the second vtkConfiguration" + mAssert.Should existingConfManager.configurations(2).isDEV, "The second configuration is expected to be DEV" + mAssert.Equals existingConfManager.configurations(2).name, "ExistingProject_DEV", "Name of the configuration for the second vtkConfiguration" + mAssert.Equals existingConfManager.configurations("ExistingProject_DEV").name, "ExistingProject_DEV", "Name of the configuration for the second vtkConfiguration" + mAssert.Equals existingConfManager.configurations(2).comment, "Existing project for development for various tests of VBAToolKit", "Comment got by number of the second configuration" + mAssert.Equals existingConfManager.configurations("ExistingProject_DEV").comment, "Existing project for development for various tests of VBAToolKit", "Comment got by name of the second configuration" + mAssert.Equals existingConfManager.configurations(2).template, "Templates\ExistingProjectTemplate.xlsm", "Template got by number of the second configuration" + mAssert.Equals existingConfManager.configurations("ExistingProject_DEV").template, "Templates\ExistingProjectTemplate.xlsm", "Template got by name of the second configuration" + mAssert.Equals existingConfManager.configurations(2).projectName, "ExistingProject_DEV", "Project Name (Title) got by number of the second configuration" + mAssert.Equals existingConfManager.configurations("ExistingProject_DEV").projectName, "ExistingProject_DEV", "Project Name (Title) got by name of the second configuration" + On Error GoTo 0 + Exit Sub +M_Error: + mAssert.Should False, "Unexpected error (" & Err.Number & ") : " & Err.Description +End Sub + +Public Sub TestGetConfigurationReferencesWithNumber() +' Check the behavior of the getConfigurationReferencesWithNumber function + Dim refNames(), i As Integer, cn As Integer, c1 As Collection, c2 As Collection, r As vtkReference + Dim expectedCount As Integer + refNames = Array("VBA", "Excel", "stdole", "Office", "MSForms", "Scripting", "VBIDE", "Shell32", "MSXML2") + On Error Resume Next + For cn = 1 To existingConfManager.configurationCount + Set c1 = existingConfManager.configurations(cn).references + ' Rearrange the collection by name + Set c2 = New Collection + For Each r In c1 + c2.Add r, r.name + Next + expectedCount = UBound(refNames) - LBound(refNames) + 1 + If existingConfManager.configurations(cn).isDEV Then expectedCount = expectedCount + 1 + mAssert.Equals c2.count, expectedCount, "Count of references in configuration " & cn + ' il faut boucler sur le tableau et rechercher dans la collection (si pas trouvé = erreur) + For i = LBound(refNames) To UBound(refNames) + Set r = c2(refNames(i)) + mAssert.Equals Err.Number, 0, "Error when getting " & refNames(i) & " reference from configuration " & cn + Next i + If existingConfManager.configurations(cn).isDEV Then + Set r = c2("VBAToolKit") + mAssert.Equals Err.Number, 0, "Error when getting VBAToolKit reference from configuration " & cn + End If + Next cn + On Error GoTo 0 +End Sub + +Public Sub TestRootPathForExistingProject() + mAssert.Equals existingConfManager.rootPath, vtkPathOfCurrentProject, "The root Path is not initialized for a new Workbook" + mAssert.Equals existingConfManager.rootPath, vtkPathOfCurrentProject, "The second call to rootPath give the same result as the previous one" +End Sub + +Public Sub TestGetAllReferencesFromExistingWorkbook() +' Verify that all references are listed from existing workbook + Dim refNames(), i As Integer, c1 As Collection, c2 As Collection, r As vtkReference + refNames = Array("VBA", "Excel", "stdole", "Office", "MSForms", "Scripting", "VBIDE", "Shell32", "MSXML2", "VBAToolKit", "EventSystemLib") + + On Error Resume Next + Set c1 = existingConfManager.references + ' Rearrange the collection by name + Set c2 = New Collection + For Each r In c1 + c2.Add r, r.name + Next + mAssert.Equals c2.count, UBound(refNames) - LBound(refNames) + 1, "Count of all references of a new workbook" + ' il faut boucler sur le tableau et rechercher dans la collection (si pas trouvé = erreur) + For i = LBound(refNames) To UBound(refNames) + Set r = c2(refNames(i)) + mAssert.Equals Err.Number, 0, "Error when getting " & refNames(i) & " reference" + Next i + On Error GoTo 0 +End Sub + +Private Function ITest_Suite() As TestSuite + Set ITest_Suite = New TestSuite + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_Init_FileNotFound" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_Init_BadXMLFile" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_Init_ObsoleteXMLFile" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_ForbiddenSetterCalls" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_PropertyName_DefaultGet" + ITest_Suite.AddTest ITest_Manager.ClassName, "TestGetConfigurationsFromExistingProject" + ITest_Suite.AddTest ITest_Manager.ClassName, "TestGetConfigurationPathWithNumberFromExistingProject" + ITest_Suite.AddTest ITest_Manager.ClassName, "TestGetConfigurationProjectNameWithNumberFromExistingProject" + ITest_Suite.AddTest ITest_Manager.ClassName, "TestGetConfigurationCommentWithNumberFromExistingProject" + ITest_Suite.AddTest ITest_Manager.ClassName, "TestGetConfigurationTemplateWithNumberFromExistingProject" + ITest_Suite.AddTest ITest_Manager.ClassName, "TestGetConfigurationNumbersFromExistingProject" + ITest_Suite.AddTest ITest_Manager.ClassName, "TestGetConfigurationPathFromExistingProject" + ITest_Suite.AddTest ITest_Manager.ClassName, "TestGetModulesFromExistingProject" + ITest_Suite.AddTest ITest_Manager.ClassName, "TestGetModuleNumbersFromExistingProject" + ITest_Suite.AddTest ITest_Manager.ClassName, "TestGetModulePathWithNumberFromExistingProject" + ITest_Suite.AddTest ITest_Manager.ClassName, "TestModulesFromExistingProject" + ITest_Suite.AddTest ITest_Manager.ClassName, "TestConfigurationsCollectionFromExistingProject" + ITest_Suite.AddTest ITest_Manager.ClassName, "TestGetConfigurationReferencesWithNumber" + ITest_Suite.AddTest ITest_Manager.ClassName, "TestRootPathForExistingProject" + ITest_Suite.AddTest ITest_Manager.ClassName, "TestGetAllReferencesFromExistingWorkbook" +End Function + +Private Sub ITestCase_RunTest() + Select Case mManager.methodName + Case "Test_Init_FileNotFound": Test_Init_FileNotFound + Case "Test_Init_BadXMLFile": Test_Init_BadXMLFile + Case "Test_Init_ObsoleteXMLFile": Test_Init_ObsoleteXMLFile + Case "Test_ForbiddenSetterCalls": Test_ForbiddenSetterCalls + Case "Test_PropertyName_DefaultGet": Test_PropertyName_DefaultGet + Case "TestGetConfigurationsFromExistingProject": TestGetConfigurationsFromExistingProject + Case "TestGetConfigurationPathWithNumberFromExistingProject": TestGetConfigurationPathWithNumberFromExistingProject + Case "TestGetConfigurationProjectNameWithNumberFromExistingProject": TestGetConfigurationProjectNameWithNumberFromExistingProject + Case "TestGetConfigurationCommentWithNumberFromExistingProject": TestGetConfigurationCommentWithNumberFromExistingProject + Case "TestGetConfigurationTemplateWithNumberFromExistingProject": TestGetConfigurationTemplateWithNumberFromExistingProject + Case "TestGetConfigurationNumbersFromExistingProject": TestGetConfigurationNumbersFromExistingProject + Case "TestGetConfigurationPathFromExistingProject": TestGetConfigurationPathFromExistingProject + Case "TestGetModulesFromExistingProject": TestGetModulesFromExistingProject + Case "TestGetModuleNumbersFromExistingProject": TestGetModuleNumbersFromExistingProject + Case "TestGetModulePathWithNumberFromExistingProject": TestGetModulePathWithNumberFromExistingProject + Case "TestModulesFromExistingProject": TestModulesFromExistingProject + Case "TestConfigurationsCollectionFromExistingProject": TestConfigurationsCollectionFromExistingProject + Case "TestGetConfigurationReferencesWithNumber": TestGetConfigurationReferencesWithNumber + Case "TestRootPathForExistingProject": TestRootPathForExistingProject + Case "TestGetAllReferencesFromExistingWorkbook": TestGetAllReferencesFromExistingWorkbook + Case Else: mAssert.Should False, "Invalid test name: " & mManager.methodName + End Select +End Sub + + diff --git a/Source/ConfTest/vtkRecreateConfigurationTester.cls b/Source/ConfTest/vtkRecreateConfExcelTester.cls similarity index 96% rename from Source/ConfTest/vtkRecreateConfigurationTester.cls rename to Source/ConfTest/vtkRecreateConfExcelTester.cls index 1e8a5fb..88174e7 100644 --- a/Source/ConfTest/vtkRecreateConfigurationTester.cls +++ b/Source/ConfTest/vtkRecreateConfExcelTester.cls @@ -2,15 +2,15 @@ VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END -Attribute VB_Name = "vtkRecreateConfigurationTester" +Attribute VB_Name = "vtkRecreateConfExcelTester" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False '--------------------------------------------------------------------------------------- -' Module : vtkRecreateConfigurationTester +' Module : vtkRecreateConfExcelTester ' Author : Lucas Vitorino -' Purpose : Test the vtkRecreateConfiguration function +' Purpose : Test the vtkRecreateConfiguration function with Excel Conf Manager ' ' Copyright 2013 Skwal-Soft (http://skwalsoft.com) ' @@ -181,7 +181,7 @@ Private Sub exportModulesAndRecreateWb(Wb As Workbook, testProject As vtkProject exportModulesAndRecreateWb_Error: Err.Source = "exportModulesAndRecreateWb of module vtkRecreateConfigurationTester" - Err.Raise Err.Number, Err.Source, Err.Description + Err.Raise Err.Number, Err.source, Err.Description Exit Sub End Sub @@ -226,7 +226,9 @@ Public Sub Test_vtkRecreateConfigurations_normalConf() Set testedConf = normalConf vtkExportConfiguration Wb.VBProject, testProject.projectName, testedConf.name - vtkRecreateConfigurations testProject.projectName, testedConf.name + Dim confNames As New Collection + confNames.Add testedConf.name + vtkRecreateConfigurations cm, confNames Set recreatedWb = Workbooks.Open(VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testedConf.path) mAssert.Should fso.FileExists(VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testedConf.path), _ diff --git a/Source/ConfTest/vtkRecreateConfXMLTester.cls b/Source/ConfTest/vtkRecreateConfXMLTester.cls new file mode 100644 index 0000000..5ce8899 --- /dev/null +++ b/Source/ConfTest/vtkRecreateConfXMLTester.cls @@ -0,0 +1,865 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "vtkRecreateConfXMLTester" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +'--------------------------------------------------------------------------------------- +' Module : vtkRecreateConfXMLTester +' Author : Jean-Pierre IMBERT +' Purpose : Test the vtkRecreateConfiguration function with XML Conf Manager +' +' Copyright 2014 Skwal-Soft (http://skwalsoft.com) +' +' Licensed under the Apache License, Version 2.0 (the "License"); +' you may not use this file except in compliance with the License. +' You may obtain a copy of the License at +' +' http://www.apache.org/licenses/LICENSE-2.0 +' +' Unless required by applicable law or agreed to in writing, software +' distributed under the License is distributed on an "AS IS" BASIS, +' WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +' See the License for the specific language governing permissions and +' limitations under the License. +'--------------------------------------------------------------------------------------- + + +Option Explicit +Implements ITest +Implements ITestCase + +Private mManager As TestCaseManager +Private mAssert As IAssert + +Private fso As FileSystemObject + +Private Wb As Workbook +Private recreatedWb As Workbook +Private testProject As vtkProject +Private normalConf As vtkConfiguration +Private emptyConf As vtkConfiguration +Private notExistingPathConf1 As vtkConfiguration +Private notExistingPathConf2 As vtkConfiguration +Private xlsConf As vtkConfiguration +Private xlamConf As vtkConfiguration +Private xlaConf As vtkConfiguration +Private multitypeConf As vtkConfiguration +Private noTemplateConf As vtkConfiguration +Private VTKConf As vtkConfiguration +Private VTKProjectConf As vtkConfiguration +Private testedConf As vtkConfiguration + +Private cm As vtkConfigurationManager + +Private Const testProjectName = "TestProjectForRecreateConf" +Private Const normalConfName = "TestProject_normalConf" +Private Const normalConfTemplate = "TestProjectTemplate.xlsx" +Private Const emptyConfName = "TestProject_emptyConf" +Private Const notExistingPathConf1Name = "TestProject_notExistingPathConf1" +Private Const notExistingPathConf2Name = "TestProject_notExistingPathConf2" +Private Const xlsConfName = "TestProject_xlsConf" +Private Const xlamConfName = "TestProject_xlamConf" +Private Const xlaConfName = "TestProject_xlaConf" +Private Const multitypeConfName = "TestProject_multitypeConf" +Private Const noTemplateConfName = "TestProject_NoTemplate" +Private Const VTKConfName = "TestProject_VTKConf" +Private Const VTKProjectConfName = "VBAToolKit" + +Private Sub Class_Initialize() + Set mManager = New TestCaseManager +End Sub + +Private Property Get ITestCase_Manager() As TestCaseManager + Set ITestCase_Manager = mManager +End Property + +Private Property Get ITest_Manager() As ITestManager + Set ITest_Manager = mManager +End Property + +Private Sub ITestCase_SetUp(Assert As IAssert) + + Set mAssert = Assert + + Set fso = New FileSystemObject + + Set testProject = vtkProjectForName(testProjectName) + + Dim testProjectFolder As String, cmXML As vtkConfigurationManagerXML + + testProjectFolder = fso.BuildPath(VBAToolKit.vtkTestPath, testProject.projectName) + vtkCreateTreeFolder testProjectFolder + + Set Wb = getTestFileFromTemplate(testProject.workbookDEVName, _ + destinationName:=fso.BuildPath(testProject.projectName, testProject.projectDEVStandardRelativePath), _ + openExcel:=True) + + getTestFileFromTemplate fileName:=normalConfTemplate, _ + destinationName:=fso.BuildPath(testProject.projectName, "Templates" & "\" & normalConfTemplate), _ + openExcel:=False + + getTestFileFromTemplate fileName:=testProject.XMLConfigurationName, _ + destinationName:=fso.BuildPath(testProject.projectName, testProject.XMLConfigurationStandardRelativePath), _ + openExcel:=False + + Set cmXML = New vtkConfigurationManagerXML + cmXML.init VBAToolKit.vtkTestPath & "\" & fso.BuildPath(testProject.projectName, testProject.XMLConfigurationStandardRelativePath) + Set cm = cmXML + + Set normalConf = cm.configurations(normalConfName) + Set emptyConf = cm.configurations(emptyConfName) + Set notExistingPathConf1 = cm.configurations(notExistingPathConf1Name) + Set notExistingPathConf2 = cm.configurations(notExistingPathConf2Name) + Set xlsConf = cm.configurations(xlsConfName) + Set xlamConf = cm.configurations(xlamConfName) + Set xlaConf = cm.configurations(xlaConfName) + Set multitypeConf = cm.configurations(multitypeConfName) + Set noTemplateConf = cm.configurations(noTemplateConfName) + Set VTKConf = cm.configurations(VTKConfName) + Set VTKProjectConf = cm.configurations(VTKProjectConfName) + + On Error GoTo 0 + Exit Sub + +err_handler: + Debug.Print "SETUP : Unexpected error " & Err.Number & " (" & Err.Description & ") in " & Err.Source + ITestCase_TearDown + Exit Sub +End Sub + +Private Sub ITestCase_TearDown() + On Error Resume Next + vtkCloseAndKillWorkbook Wb + vtkCloseAndKillWorkbook recreatedWb + VBAToolKit.resetTestFolder + vtkResetProjects + vtkResetConfigurationManagers +End Sub + +' TESTS TO BE WRITTEN +' +' - workbook is created in the good path +' - normal conf +' - empty conf +' - multitype conf +' - modules have not been exported +' - normal : raise error VTK_NO_SOURCE_FILES +' - empty conf : raise no error +' - workbook is to be created in a path that does not exist yet +' - all modules of the configuration are present +' - normal conf +' - multitype conf +' - references are activated ( will probably change in the near future as reference management in configurations will change) +' - normal conf +' - name of the vbproject is correct : same name as the recreated configuration +' - normal conf +' - fileFormat is consistent with the extension +' - xlsm +' - xlam +' - xls +' - xla +' +' particular cases +' - workbook with the same name is already open : raise error VTK_WORKBOOK_ALREADY_OPEN +' - VBProject with the same name is already open : raise error VTK_VBPROJECT_ALREADY_OPEN +' - add-in with the same name is activated : export the file normally +' - workbook with the same name already exists in the same path : overwrite the file +' - normal conf +' - xlam + +' -------------------------------------------------------- +' PRIVATE UTILITY FUNCTIONS +' -------------------------------------------------------- + +Private Sub exportModulesAndRecreateWb(Wb As Workbook, testProject As vtkProject, testedConf As vtkConfiguration) + ' It is mandatory to create the source files before recreating a configuration + On Error GoTo exportModulesAndRecreateWb_Error + + vtkExportConfiguration Wb.VBProject, testProject.projectName, testedConf.name + vtkRecreateConfiguration testProject.projectName, testedConf.name, cm + Set recreatedWb = Workbooks.Open(VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testedConf.path) + + On Error GoTo 0 + Exit Sub + +exportModulesAndRecreateWb_Error: + Err.Source = "exportModulesAndRecreateWb of module vtkRecreateConfigurationTester" + Err.Raise Err.Number, Err.source, Err.Description + Exit Sub +End Sub + +Private Sub verifyV11Properties(Wb As Workbook, confNumber As Integer) + mAssert.Equals Wb.VBProject.name, "ProjectName" & confNumber, "Expected project name" + mAssert.Equals Wb.BuiltinDocumentProperties("Title").Value, "ProjectName" & confNumber, "Expected Workbook title" + mAssert.Equals Wb.BuiltinDocumentProperties("Comments").Value, "Comment for Workbook #" & confNumber, "Expected Workbook comment" +End Sub + +' -------------------------------------------------------- +' TESTS +' -------------------------------------------------------- + +Public Sub Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_normalConf() +' workbook is created in the good path + + On Error GoTo Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_normalConf_Error + + Set testedConf = normalConf + + exportModulesAndRecreateWb wb, testProject, testedConf + + mAssert.Should fso.FileExists(VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testedConf.path), _ + "The configuration should have been created in the designated path." + verifyV11Properties recreatedWb, testedConf.Number + + On Error GoTo 0 + Exit Sub + +Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_normalConf_Error: + Err.Source = "Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_normalConf of module vtkRecreateConfigurationTester" + mAssert.Should False, "Unexpected error " & Err.Number & " (" & Err.Description & ") in " & Err.Source + Exit Sub +End Sub + +Public Sub Test_vtkRecreateConfigurations_normalConf() +' Same test than previous one but call of main function instead of utility function +' The normal conf contains a template ; check the use of this template + + On Error GoTo Test_vtkRecreateConfiguration_normalConf_Error + + Set testedConf = normalConf + + vtkExportConfiguration Wb.VBProject, testProject.projectName, testedConf.name + Dim confNames As New Collection + confNames.Add testedConf.name + vtkRecreateConfigurations cm, confNames + Set recreatedWb = Workbooks.Open(VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testedConf.path) + + mAssert.Should fso.FileExists(VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testedConf.path), _ + "The configuration should have been created in the designated path." + + mAssert.Equals recreatedWb.Sheets("TestProject").Range("A1").Value, "TestProjectTemplate", "The configuration should have use a template" + + On Error GoTo 0 + Exit Sub + +Test_vtkRecreateConfiguration_normalConf_Error: + Err.Source = "Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_normalConf of module vtkRecreateConfigurationTester" + mAssert.Should False, "Unexpected error " & Err.Number & " (" & Err.Description & ") in " & Err.Source + Exit Sub +End Sub + +Public Sub Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_emptyConf() +' workbook is created in the good path + + On Error GoTo Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_emptyConf_Error + + Set testedConf = emptyConf + + exportModulesAndRecreateWb wb, testProject, testedConf + + mAssert.Should fso.FileExists(VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testedConf.path), _ + "The configuration should have been created in the designated path." + + On Error GoTo 0 + Exit Sub + +Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_emptyConf_Error: + Err.Source = "Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_emptyConf of module vtkRecreateConfigurationTester" + mAssert.Should False, "Unexpected error " & Err.Number & " (" & Err.Description & ") in " & Err.Source + Exit Sub +End Sub + +Public Sub Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_multitypeConf() +' workbook is created in the good path + + On Error GoTo Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_multitypeConf_Error + + Set testedConf = multitypeConf + + exportModulesAndRecreateWb wb, testProject, testedConf + + mAssert.Should fso.FileExists(VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testedConf.path), _ + "The configuration should have been created in the designated path." + verifyV11Properties recreatedWb, testedConf.Number + + On Error GoTo 0 + Exit Sub + +Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_multitypeConf_Error: + Err.Source = "Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_multitypeConf of module vtkRecreateConfigurationTester" + mAssert.Should False, "Unexpected error " & Err.Number & " (" & Err.Description & ") in " & Err.Source + Exit Sub +End Sub + +Public Sub Test_vtkRecreateConfiguration_modulesNotYetExported_normalConf() +' modules have not been exported, normal conf : raise error VTK_NO_SOURCE_FILES + + On Error GoTo Test_vtkRecreateConfiguration_modulesNotYetExported_normalConf_Error + + Dim error As Integer: error = 0 + + Set testedConf = normalConf + + vtkRecreateConfiguration testProject.projectName, testedConf.name, cm + + mAssert.Equals error, VTK_NO_SOURCE_FILES + + On Error GoTo 0 + Exit Sub + +Test_vtkRecreateConfiguration_modulesNotYetExported_normalConf_Error: + error = Err.Number + Resume Next +End Sub + +Public Sub Test_vtkRecreateConfiguration_modulesNotYetExported_emptyConf() +' modules have not been exported, empty conf : don't raise error, create the file normally + + On Error GoTo Test_vtkRecreateConfiguration_modulesNotYetExported_emptyConf_Error + + Dim error As Integer: error = 0 + + Set testedConf = emptyConf + + vtkRecreateConfiguration testProject.projectName, testedConf.name, cm + + mAssert.Equals error, 0, _ + "Error " & Err.Number & " (" & Err.Description & ") occured." + + mAssert.Should fso.FileExists(VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testedConf.path), _ + "The file shoud have been created normally as configuration is empty." + verifyV11Properties recreatedWb, testedConf.Number + + On Error GoTo 0 + Exit Sub + +Test_vtkRecreateConfiguration_modulesNotYetExported_emptyConf_Error: + error = Err.Number + Resume Next +End Sub + +Public Sub Test_vtkRecreateConfiguration_pathDoesNotExistYet1() +' normal conf, 1-level path does not exist yet : don't raise error, create the file normally + + On Error GoTo Test_vtkRecreateConfiguration_pathDoesNotExistYet1_Error + + Dim error As Integer: error = 0 + + Set testedConf = notExistingPathConf1 + + exportModulesAndRecreateWb wb, testProject, testedConf + + mAssert.Equals error, 0, _ + "Error " & error & " (" & Err.Description & ") occured. It shouldn't have." + + mAssert.Should fso.FileExists(VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testedConf.path), _ + "The file shoud have been created normally." + verifyV11Properties recreatedWb, testedConf.Number + + On Error GoTo 0 + Exit Sub + +Test_vtkRecreateConfiguration_pathDoesNotExistYet1_Error: + error = Err.Number + Resume Next +End Sub + +Public Sub Test_vtkRecreateConfiguration_pathDoesNotExistYet2() +' normal conf, 2-level path does not exist yet : raise error VTK_WRONG_FILE_PATH, don't create the file + + On Error GoTo Test_vtkRecreateConfiguration_pathDoesNotExistYet2_Error + + Dim error As Integer: error = 0 + + Set testedConf = notExistingPathConf2 + + exportModulesAndRecreateWb wb, testProject, testedConf + + mAssert.Equals error, 0, _ + "Error " & error & " (" & Err.Description & ") occured. It shouldn't have." + + mAssert.Should fso.FileExists(VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testedConf.path), _ + "The file shoud have been created normally." + verifyV11Properties recreatedWb, testedConf.Number + On Error GoTo 0 + Exit Sub + +Test_vtkRecreateConfiguration_pathDoesNotExistYet2_Error: + error = Err.Number + Resume Next +End Sub + +Public Sub Test_vtkRecreateConfiguration_allModulesArePresent_normalConf() +' all modules of the configuration are present + + Dim error As Integer: error = 0 + + On Error GoTo Test_vtkRecreateConfiguration_allModulesArePresent_normalConf_Error + + Set testedConf = normalConf + + exportModulesAndRecreateWb wb, testProject, testedConf + + Dim mo As vtkModule + Dim vbCmp As VBComponent + For Each mo In testedConf.modules + ' Just a dummy access attempt : will throw error 9 (subscript out of range) if the module doesn't exist + Set vbCmp = recreatedWb.VBProject.VBComponents(mo.name) + Next + + mAssert.Equals error, 0, "All modules don't exist in the recreated project." + + On Error GoTo 0 + Exit Sub + +Test_vtkRecreateConfiguration_allModulesArePresent_normalConf_Error: + If Err.Number = 9 Then + error = Err.Number + Resume Next + Else + Err.Source = "Test_vtkRecreateConfiguration_allModulesArePresent_normalConf of module vtkRecreateConfigurationTester" + mAssert.Should False, "Unexpected error " & Err.Number & " (" & Err.Description & ") in " & Err.Source + Exit Sub + End If +End Sub + +Public Sub Test_vtkRecreateConfiguration_allModulesArePresent_multitypeConf() +' all modules of the configuration are present + + Dim error As Integer: error = 0 + + On Error GoTo Test_vtkRecreateConfiguration_allModulesArePresent_multitypeConf_Error + + Set testedConf = multitypeConf + + exportModulesAndRecreateWb wb, testProject, testedConf + + Dim mo As vtkModule + Dim vbCmp As VBComponent + For Each mo In testedConf.modules + ' Just a dummy access attempt : will throw error 9 (subscript out of range) if the module doesn't exist + Set vbCmp = recreatedWb.VBProject.VBComponents(mo.name) + Next + + ' If there is no error, an assert instruction has to be executed + mAssert.Should True + + On Error GoTo 0 + Exit Sub + +Test_vtkRecreateConfiguration_allModulesArePresent_multitypeConf_Error: + If Err.Number = 9 Then + error = Err.Number + mAssert.Should False, "Module " & mo.name & "is missing." + Resume Next + Else + Err.Source = "Test_vtkRecreateConfiguration_allModulesArePresent_multitypeConf of module vtkRecreateConfigurationTester" + mAssert.Should False, "Unexpected error " & Err.Number & " (" & Err.Description & ") in " & Err.Source + Exit Sub + End If +End Sub + +Public Sub Test_vtkRecreateConfiguration_referencesAreActivated() +' references are activated +' will probably change in the near future as reference management in configurations will change + + On Error GoTo Test_vtkRecreateConfiguration_referencesAreActivated_Error + + Set testedConf = normalConf + + Dim numRef As Integer + Dim ref As Reference + Dim i As Integer + Dim refIsActive As Boolean + Dim guidArray() As String + + exportModulesAndRecreateWb wb, testProject, testedConf + + ' Listing expected references in a collection + numRef = 4 + ReDim guidArray(1 To numRef) As String + guidArray(1) = "{420B2830-E718-11CF-893D-00A0C9054228}" 'Scripting : Microsoft scripting runtime + guidArray(2) = "{0002E157-0000-0000-C000-000000000046}" ' VBIDE : Microsoft visual basic for applications extensibility 5.3 + guidArray(3) = "{50A7E9B0-70EF-11D1-B75A-00A0C90564FE}" ' Shell32 : Microsoft Shell Controls and Automation+ + guidArray(4) = "{F5078F18-C551-11D3-89B9-0000F81FE221}" ' MSXML2 : Microsoft XML V5.0 + + ' For each GUID in the array, check if it is in the project references + For i = 1 To numRef + refIsActive = False + For Each ref In recreatedWb.VBProject.references + If ref.GUID = guidArray(i) Then refIsActive = True + Next + + mAssert.Should refIsActive, "The reference with GUID = " & guidArray(i) & " is not activated : it should." + Next + + On Error GoTo 0 + Exit Sub + +Test_vtkRecreateConfiguration_referencesAreActivated_Error: + Err.Source = "Test_vtkRecreateConfiguration_referencesAreActivated of module vtkRecreateConfigurationTester" + mAssert.Should False, "Unexpected error " & Err.Number & " (" & Err.Description & ") in " & Err.Source + Exit Sub +End Sub + +Public Sub Test_vtkRecreateConfiguration_nameOfTheVBProjectIsCorrect() +' name of the vbproject is correct : same name as the recreated configuration + + On Error GoTo Test_vtkRecreateConfiguration_nameOfTheVBProjectIsCorrect_Error + + Set testedConf = normalConf + + ' Set recreatedWb and open it + exportModulesAndRecreateWb wb, testProject, testedConf + + mAssert.Equals recreatedWb.VBProject.name, "ProjectName" & testedConf.Number, _ + "The created project should have the same name as the recreated configuration." + + On Error GoTo 0 + Exit Sub + +Test_vtkRecreateConfiguration_nameOfTheVBProjectIsCorrect_Error: + Err.Source = "Test_vtkRecreateConfiguration_nameOfTheVBProjectIsCorrect of module vtkRecreateConfigurationTester" + mAssert.Should False, "Unexpected error " & Err.Number & " (" & Err.Description & ") in " & Err.Source + Exit Sub +End Sub + +Public Sub Test_vtkRecreateConfiguration_formatLikeExtension_XLSM() +' test the xlsm format + + On Error GoTo Test_vtkRecreateConfiguration_formatLikeExtension_XLSM_Error + + Set testedConf = normalConf + + exportModulesAndRecreateWb wb, testProject, testedConf + + mAssert.Equals recreatedWb.FileFormat, _ + xlOpenXMLWorkbookMacroEnabled, _ + "File format is wrong." + + On Error GoTo 0 + Exit Sub + +Test_vtkRecreateConfiguration_formatLikeExtension_XLSM_Error: + Err.Source = "Test_vtkRecreateConfiguration_formatLikeExtension_XLSM of module vtkRecreateConfigurationTester" + mAssert.Should False, "Unexpected error " & Err.Number & " (" & Err.Description & ") in " & Err.Source + Exit Sub +End Sub + +Public Sub Test_vtkRecreateConfiguration_formatLikeExtension_XLAM() +' test the xlam format + + On Error GoTo Test_vtkRecreateConfiguration_formatLikeExtension_XLAM_Error + + Set testedConf = xlamConf + + exportModulesAndRecreateWb wb, testProject, testedConf + + mAssert.Equals recreatedWb.FileFormat, _ + xlOpenXMLAddIn, _ + "File format is wrong." + verifyV11Properties recreatedWb, testedConf.Number + + On Error GoTo 0 + Exit Sub + +Test_vtkRecreateConfiguration_formatLikeExtension_XLAM_Error: + Err.Source = "Test_vtkRecreateConfiguration_formatLikeExtension_XLAM of module vtkRecreateConfigurationTester" + mAssert.Should False, "Unexpected error " & Err.Number & " (" & Err.Description & ") in " & Err.Source + Exit Sub +End Sub + +Public Sub Test_vtkRecreateConfiguration_formatLikeExtension_XLS() +' test the xls format + + On Error GoTo Test_vtkRecreateConfiguration_formatLikeExtension_XLS_Error + + Set testedConf = xlsConf + + exportModulesAndRecreateWb wb, testProject, testedConf + + mAssert.Equals recreatedWb.FileFormat, _ + xlExcel8, _ + "File format is wrong." + verifyV11Properties recreatedWb, testedConf.Number + + On Error GoTo 0 + Exit Sub + +Test_vtkRecreateConfiguration_formatLikeExtension_XLS_Error: + Err.Source = "Test_vtkRecreateConfiguration_formatLikeExtension_XLS of module vtkRecreateConfigurationTester" + mAssert.Should False, "Unexpected error " & Err.Number & " (" & Err.Description & ") in " & Err.Source + Exit Sub +End Sub + +Public Sub Test_vtkRecreateConfiguration_formatLikeExtension_XLA() +' test the xla format + + On Error GoTo Test_vtkRecreateConfiguration_formatLikeExtension_XLA_Error + + Set testedConf = xlaConf + + exportModulesAndRecreateWb wb, testProject, testedConf + + mAssert.Equals recreatedWb.FileFormat, _ + xlAddIn, _ + "File format is wrong." + verifyV11Properties recreatedWb, testedConf.Number + + On Error GoTo 0 + Exit Sub + +Test_vtkRecreateConfiguration_formatLikeExtension_XLA_Error: + Err.Source = "Test_vtkRecreateConfiguration_formatLikeExtension_XLA of module vtkRecreateConfigurationTester" + mAssert.Should False, "Unexpected error " & Err.Number & " (" & Err.Description & ") in " & Err.Source + Exit Sub +End Sub + +Public Sub Test_vtkRecreateConfiguration_workbookOpen() +' workbook with the same name is already open : raise error VTK_WORKBOOK_ALREADY_OPEN + + Dim error As Integer: error = 0 + + On Error GoTo Test_vtkRecreateConfiguration_workbookOpen_Error + + Set testedConf = normalConf + + ' Create and open recreatedWb + exportModulesAndRecreateWb wb, testProject, testedConf + + ' Recreate configuration with recreateWb already open + vtkRecreateConfiguration testProject.projectName, testedConf.name, cm + + mAssert.Equals error, VTK_WORKBOOK_ALREADY_OPEN + + On Error GoTo 0 + Exit Sub + +Test_vtkRecreateConfiguration_workbookOpen_Error: + If Err.Number = VTK_WORKBOOK_ALREADY_OPEN Then + error = Err.Number + Resume Next + Else + Err.Source = "Test_vtkRecreateConfiguration_workbookOpen of module vtkRecreateConfigurationTester" + mAssert.Should False, "Unexpected error " & Err.Number & " (" & Err.Description & ") in " & Err.Source + Exit Sub + End If +End Sub + +Public Sub Test_vtkRecreateConfiguration_addInOpen_XLAM() +' add-in with the same name is activated : recreate the configuration normally + + Dim error As Integer: error = 0 + + On Error GoTo Test_vtkRecreateConfiguration_addInOpen_Error + + Set testedConf = VTKConf + + ' Recreate the configuration called just like an actived add-in : "VBAToolKit.xlam" + ' NB : the recreated workbook is not opened + vtkExportConfiguration Wb.VBProject, testProject.projectName, testedConf.name + vtkRecreateConfiguration testProject.projectName, testedConf.name, cm + + mAssert.Equals error, 0 + + On Error GoTo 0 + Exit Sub + +Test_vtkRecreateConfiguration_addInOpen_Error: + error = Err.Number + Resume Next +End Sub + +Public Sub Test_vtkRecreateConfiguration_workbookAndVbProjectAlreadyOpen() +' workbook and vbproject with the same name already open -> there shouldn't be errors + + Dim error As Integer: error = 0 + + On Error GoTo Test_vtkRecreateConfiguration_workbookAndVbProjectAlreadyOpen_Error + + Set testedConf = VTKProjectConf + + ' Recreate the configuration called just like an actived add-in : "VBAToolKit.xlam" + ' NB : the recreated workbook is not opened + vtkExportConfiguration Wb.VBProject, testProject.projectName, testedConf.name + vtkRecreateConfiguration testProject.projectName, testedConf.name, cm + + mAssert.Equals error, 0 + + On Error GoTo 0 + Exit Sub + +Test_vtkRecreateConfiguration_workbookAndVbProjectAlreadyOpen_Error: + error = Err.Number + Resume Next +End Sub + +Public Sub Test_vtkRecreateConfiguration_unreachableTemplate() +' workbook with an unexisting template + + Dim error As Integer: error = 0 + + On Error GoTo M_Error + + Set testedConf = noTemplateConf + vtkExportConfiguration Wb.VBProject, testProject.projectName, testedConf.name + + On Error Resume Next + vtkRecreateConfiguration testProject.projectName, testedConf.name, cm + mAssert.Equals Err.Number, VTK_TEMPLATE_NOT_FOUND, "Error returned by vtkRecreateConfiguration" + On Error GoTo 0 + Exit Sub + +M_Error: + mAssert.Should False, "Unexpected error " & Err.Number & " (" & Err.Description & ")" +End Sub + +Public Sub Test_vtkRecreateConfiguration_overwriteFile_normal() +' file already exists : overwrite it + + On Error GoTo Test_vtkRecreateConfiguration_overwriteFile_normal_Error + + Dim oldSize As Integer + Dim newSize As Integer + + Set testedConf = normalConf + + fso.CreateTextFile (VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testedConf.path) + oldSize = fso.GetFile(VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testedConf.path).Size + + ' Create and open recreatedWb + exportModulesAndRecreateWb wb, testProject, testedConf + + newSize = fso.GetFile(VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testedConf.path).Size + + mAssert.Should newSize > oldSize, "File should have been overwritten." + + On Error GoTo 0 + Exit Sub + +Test_vtkRecreateConfiguration_overwriteFile_normal_Error: + Err.Source = "Test_vtkRecreateConfiguration_overwriteFile_normal of module vtkRecreateConfigurationTester" + mAssert.Should False, "Unexpected error " & Err.Number & " (" & Err.Description & ") in " & Err.Source + Exit Sub +End Sub + +Public Sub Test_vtkRecreateConfiguration_overwriteFile_addIn() +' add-in already exists : overwrite it + + On Error GoTo Test_vtkRecreateConfiguration_overwriteFile_addIn_Error + + Dim oldSize As Integer + Dim newSize As Integer + + Set testedConf = xlamConf + + fso.CreateTextFile (VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testedConf.path) + oldSize = fso.GetFile(VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testedConf.path).Size + + ' Create and open recreatedWb + exportModulesAndRecreateWb wb, testProject, testedConf + + newSize = fso.GetFile(VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testedConf.path).Size + + mAssert.Should newSize > oldSize, "File should have been overwritten." + + On Error GoTo 0 + Exit Sub + +Test_vtkRecreateConfiguration_overwriteFile_addIn_Error: + Err.Source = "Test_vtkRecreateConfiguration_overwriteFile_addIn of module vtkRecreateConfigurationTester" + mAssert.Should False, "Unexpected error " & Err.Number & " (" & Err.Description & ") in " & Err.Source + Exit Sub +End Sub + +Public Sub Test_vtkRecreateConfiguration_DEVConf_normal() +' file already exists and it is the DEV configuration : overwrite it + Dim actualCm As vtkConfigurationManager + + On Error GoTo M_Error + + ' Export modules, then close WorkBook for recreation + vtkExportConfiguration Wb.VBProject, testProject.projectName, testProject.projectDEVName + Wb.Close saveChanges:=False + + ' Recreate DEV configuration then open the recreated DEV configuration + vtkRecreateConfiguration testProject.projectName, testProject.projectDEVName, cm + Set recreatedWb = Workbooks.Open(VBAToolKit.vtkTestPath & "\" & testProject.projectName & "\" & testProject.projectDEVStandardRelativePath) + + ' Create a new Excel conf manager from the DEV workbook + vtkResetConfigurationManagers + Set actualCm = vtkConfigurationManagerForProject(testProject.projectName) + + ' Test the new Conf Manager + vtkCompareConfManagers mAssert, expectedConf:=cm, actualConf:=actualCm + + On Error GoTo 0 + Exit Sub + +M_Error: + mAssert.Should False, "Unexpected error " & Err.Number & " (" & Err.Description & ") in " & Err.Source + Exit Sub +End Sub + +Private Function ITest_Suite() As TestSuite + Set ITest_Suite = New TestSuite + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_normalConf" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfigurations_normalConf" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_emptyConf" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_multitypeConf" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_modulesNotYetExported_normalConf" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_modulesNotYetExported_emptyConf" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_pathDoesNotExistYet1" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_pathDoesNotExistYet2" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_allModulesArePresent_normalConf" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_allModulesArePresent_multitypeConf" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_referencesAreActivated" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_nameOfTheVBProjectIsCorrect" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_formatLikeExtension_XLSM" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_formatLikeExtension_XLAM" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_formatLikeExtension_XLS" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_formatLikeExtension_XLA" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_workbookOpen" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_addInOpen_XLAM" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_workbookAndVbProjectAlreadyOpen" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_unreachableTemplate" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_overwriteFile_normal" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_overwriteFile_addIn" + ITest_Suite.AddTest ITest_Manager.ClassName, "Test_vtkRecreateConfiguration_DEVConf_normal" +End Function + +Private Sub ITestCase_RunTest() + Select Case mManager.methodName + Case "Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_normalConf": Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_normalConf + Case "Test_vtkRecreateConfigurations_normalConf": Test_vtkRecreateConfigurations_normalConf + Case "Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_emptyConf": Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_emptyConf + Case "Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_multitypeConf": Test_vtkRecreateConfiguration_workbookIsCreatedInTheGoodPath_multitypeConf + Case "Test_vtkRecreateConfiguration_modulesNotYetExported_normalConf": Test_vtkRecreateConfiguration_modulesNotYetExported_normalConf + Case "Test_vtkRecreateConfiguration_modulesNotYetExported_emptyConf": Test_vtkRecreateConfiguration_modulesNotYetExported_emptyConf + Case "Test_vtkRecreateConfiguration_pathDoesNotExistYet1": Test_vtkRecreateConfiguration_pathDoesNotExistYet1 + Case "Test_vtkRecreateConfiguration_pathDoesNotExistYet2": Test_vtkRecreateConfiguration_pathDoesNotExistYet2 + Case "Test_vtkRecreateConfiguration_allModulesArePresent_normalConf": Test_vtkRecreateConfiguration_allModulesArePresent_normalConf + Case "Test_vtkRecreateConfiguration_allModulesArePresent_multitypeConf": Test_vtkRecreateConfiguration_allModulesArePresent_multitypeConf + Case "Test_vtkRecreateConfiguration_referencesAreActivated": Test_vtkRecreateConfiguration_referencesAreActivated + Case "Test_vtkRecreateConfiguration_nameOfTheVBProjectIsCorrect": Test_vtkRecreateConfiguration_nameOfTheVBProjectIsCorrect + Case "Test_vtkRecreateConfiguration_formatLikeExtension_XLSM": Test_vtkRecreateConfiguration_formatLikeExtension_XLSM + Case "Test_vtkRecreateConfiguration_formatLikeExtension_XLAM": Test_vtkRecreateConfiguration_formatLikeExtension_XLAM + Case "Test_vtkRecreateConfiguration_formatLikeExtension_XLS": Test_vtkRecreateConfiguration_formatLikeExtension_XLS + Case "Test_vtkRecreateConfiguration_formatLikeExtension_XLA": Test_vtkRecreateConfiguration_formatLikeExtension_XLA + Case "Test_vtkRecreateConfiguration_workbookOpen": Test_vtkRecreateConfiguration_workbookOpen + Case "Test_vtkRecreateConfiguration_addInOpen_XLAM": Test_vtkRecreateConfiguration_addInOpen_XLAM + Case "Test_vtkRecreateConfiguration_workbookAndVbProjectAlreadyOpen": Test_vtkRecreateConfiguration_workbookAndVbProjectAlreadyOpen + Case "Test_vtkRecreateConfiguration_unreachableTemplate": Test_vtkRecreateConfiguration_unreachableTemplate + Case "Test_vtkRecreateConfiguration_overwriteFile_normal": Test_vtkRecreateConfiguration_overwriteFile_normal + Case "Test_vtkRecreateConfiguration_overwriteFile_addIn": Test_vtkRecreateConfiguration_overwriteFile_addIn + Case "Test_vtkRecreateConfiguration_DEVConf_normal": Test_vtkRecreateConfiguration_DEVConf_normal + Case Else: mAssert.Should False, "Invalid test name: " & mManager.methodName + End Select +End Sub + + + diff --git a/Source/ConfTest/vtkReferenceManagerTester.cls b/Source/ConfTest/vtkReferenceManagerTester.cls index d1e47c6..dcac102 100644 --- a/Source/ConfTest/vtkReferenceManagerTester.cls +++ b/Source/ConfTest/vtkReferenceManagerTester.cls @@ -448,12 +448,12 @@ Public Sub TestGetReferencesWithNoDevConf() ' Verify that VBAToolKit reference is not attached to any configuration Dim c As Collection + On Error GoTo M_Error + Set newRefManager = Nothing newWorkbook.Sheets("vtkReferences").name = "oldOne" Set newRefManager = New vtkReferenceManager newRefManager.init Wb:=newWorkbook, confCount:=2, nbTitleColumnsInConfSheet:=1 - - On Error GoTo M_Error ' Test references for the main configuration (#1) Set c = newRefManager.references(1) diff --git a/Source/ConfTest/vtkTestUtilities.bas b/Source/ConfTest/vtkTestUtilities.bas index fa0be4f..25bad9e 100644 --- a/Source/ConfTest/vtkTestUtilities.bas +++ b/Source/ConfTest/vtkTestUtilities.bas @@ -77,7 +77,7 @@ Public Function getTestFileFromTemplate(fileName As String, Optional destination destination = vtkTestPath & "\" & destinationName End If - FileCopy Source:=Source, destination:=destination + FileCopy Source:=source, destination:=destination ' Open Excel file if required Set getTestFileFromTemplate = Nothing @@ -130,7 +130,7 @@ Public Function getTestFolderFromTemplate(folderName As String, Optional destina destination = vtkTestPath & "\" & destinationName End If - fso.CopyFolder Source:=Source, destination:=destination, OverWriteFiles:=True + fso.CopyFolder Source:=source, destination:=destination, OverWriteFiles:=True On Error GoTo 0 Exit Function @@ -271,3 +271,59 @@ If iFileNum1 > 0 Then Close #iFileNum1 If iFileNum2 > 0 Then Close #iFileNum2 End Function +'--------------------------------------------------------------------------------------- +' Procedure : vtkCompareConfManagers +' Author : Jean-Pierre Imbert +' Date : 15/07/2014 +' Purpose : Compare Conf managers and use mAssert to report differences +'--------------------------------------------------------------------------------------- +' +Public Sub vtkCompareConfManagers(ByVal mAssert As IAssert, ByVal expectedConf As vtkConfigurationManager, ByVal actualConf As vtkConfigurationManager) + Dim refX As vtkReference, refE As vtkReference, i As Integer, j As Integer + ' Check configuration manager parameters + mAssert.Equals actualConf.projectName, expectedConf.projectName, "Project name of conf manager" + mAssert.Equals actualConf.rootPath, expectedConf.rootPath, "Root Path of conf manager" + ' Check counts + mAssert.Equals actualConf.configurationCount, expectedConf.configurationCount, "Configuration count of conf manager" + mAssert.Equals actualConf.moduleCount, expectedConf.moduleCount, "Module count of conf manager" + mAssert.Equals actualConf.references.count, expectedConf.references.count, "Reference count of conf manager" + ' Check configurations name and parameters + For i = 1 To expectedConf.configurationCount + mAssert.Equals actualConf.configuration(i), expectedConf.configuration(i), "Name of configuration number " & i + mAssert.Equals actualConf.getConfigurationPathWithNumber(i), expectedConf.getConfigurationPathWithNumber(i), "Configuration Path of configuration number " & i + mAssert.Equals actualConf.getConfigurationProjectNameWithNumber(i), expectedConf.getConfigurationProjectNameWithNumber(i), "Project name of configuration number " & i + mAssert.Equals actualConf.getConfigurationTemplateWithNumber(i), expectedConf.getConfigurationTemplateWithNumber(i), "Template path of configuration number " & i + mAssert.Equals actualConf.getConfigurationCommentWithNumber(i), expectedConf.getConfigurationCommentWithNumber(i), "Comment of configuration number " & i + Next i + ' Check modules name + For i = 1 To expectedConf.moduleCount + mAssert.Equals actualConf.module(i), expectedConf.module(i), "Name of module number " & i + Next i + ' Check references name and parameters + For i = 1 To expectedConf.references.Count + Set refX = expectedConf.references(i) + Set refE = actualConf.references(i) + mAssert.Equals refE.name, refX.name, "Name of reference number " & i + mAssert.Equals refE.relPath, refX.relPath, "Relative path of reference number " & i + mAssert.Equals refE.GUID, refX.GUID, "GUID of reference number " & i + Next i + ' Check module pathes + For i = 1 To expectedConf.configurationCount + For j = 1 To expectedConf.moduleCount + mAssert.Equals actualConf.getModulePathWithNumber(j, i), expectedConf.getModulePathWithNumber(j, i), "Module path for module " & j & " and configuration " & i + Next j + Next i + ' Check reference uses + For i = 1 To expectedConf.configurationCount + mAssert.Equals actualConf.getConfigurationReferencesWithNumber(i).count, expectedConf.getConfigurationReferencesWithNumber(i).count, "Reference count for configuration number " & i + For j = 1 To expectedConf.getConfigurationReferencesWithNumber(i).Count + Set refX = expectedConf.getConfigurationReferencesWithNumber(i)(j) + On Error Resume Next + Set refE = actualConf.getConfigurationReferencesWithNumber(i)(j) + On Error GoTo 0 + mAssert.Equals refE.id, refX.id, "Reference Id for used reference number " & j & " for configuration number " & i + Next j + Next i +End Sub + + diff --git a/Source/VbaUnit/TestClassLister.cls b/Source/VbaUnit/TestClassLister.cls index cd055a3..f3b54b7 100644 --- a/Source/VbaUnit/TestClassLister.cls +++ b/Source/VbaUnit/TestClassLister.cls @@ -56,12 +56,14 @@ Public Function SelectTestClass(TestClassName As String) As ITest Case "vtkNormalizeTester": Set SelectTestClass = New vtkNormalizeTester Case "vtkXMLExportTester": Set SelectTestClass = New vtkXMLExportTester Case "vtkFileSystemUtilitiesTester": Set SelectTestClass = New vtkFileSystemUtilitiesTester - Case "vtkRecreateConfigurationTester": Set SelectTestClass = New vtkRecreateConfigurationTester + Case "vtkRecreateConfExcelTester": Set SelectTestClass = New vtkRecreateConfExcelTester Case "vtkExcelUtilitiesTester": Set SelectTestClass = New vtkExcelUtilitiesTester - Case "vtkConfigurationManager10Tester": Set SelectTestClass = New vtkConfigurationManager10Tester - Case "vtkConfigurationManager11Tester": Set SelectTestClass = New vtkConfigurationManager11Tester + Case "vtkConfManagerExcel10Tester": Set SelectTestClass = New vtkConfManagerExcel10Tester + Case "vtkConfManagerExcel11Tester": Set SelectTestClass = New vtkConfManagerExcel11Tester Case "vtkTestUtilitiesTester": Set SelectTestClass = New vtkTestUtilitiesTester Case "vtkReferenceManagerTester": Set SelectTestClass = New vtkReferenceManagerTester + Case "vtkConfManagerXML20Tester": Set SelectTestClass = New vtkConfManagerXML20Tester + Case "vtkRecreateConfXMLTester": Set SelectTestClass = New vtkRecreateConfXMLTester Case Else: End Select End Function diff --git a/Templates/EmptyXMLForConfigurationsTests.xml b/Templates/EmptyXMLForConfigurationsTests.xml new file mode 100644 index 0000000..30d9798 --- /dev/null +++ b/Templates/EmptyXMLForConfigurationsTests.xml @@ -0,0 +1,106 @@ + + + + + + + + + + + + + + + + + + + + +]> + + + + 1.0 + ExistingProject + + + + VBA + {000204EF-0000-0000-C000-000000000046} + + + Excel + {00020813-0000-0000-C000-000000000046} + + + stdole + {00020430-0000-0000-C000-000000000046} + + + Office + {2DF8D04C-5BFA-101B-BDE5-00AA0044DE52} + + + MSForms + {0D452EE1-E08F-101A-852E-02608C4D0BB4} + + + Scripting + {420B2830-E718-11CF-893D-00A0C9054228} + + + VBIDE + {0002E157-0000-0000-C000-000000000046} + + + Shell32 + {50A7E9B0-70EF-11D1-B75A-00A0C90564FE} + + + MSXML2 + {F5078F18-C551-11D3-89B9-0000F81FE221} + + + EventSystemLib + {4E14FB90-2E22-11D1-9964-00C04FBBB345} + + + VBAToolKit + C:\Documents and Settings\Demonn\Application Data\Microsoft\AddIns\VBAToolKit.xlam + + + ExistingProject + Delivery\ExistingProject.xlsm + ExistingProjectName + Existing project for various tests of VBAToolKit + + + ExistingProject_DEV + Project\ExistingProject_DEV.xlsm + ExistingProject_DEV + Existing project for development for various tests of VBAToolKit + + + Module1 + Path1Module1 + + + Module2 + Path2Module2 + + + Module3 + + + Module4 + Path1Module4 + Path2Module4 + + + Module5 + Path2Module5 + + diff --git a/Templates/TestProjectForRecreateConf.xml b/Templates/TestProjectForRecreateConf.xml new file mode 100644 index 0000000..f689417 --- /dev/null +++ b/Templates/TestProjectForRecreateConf.xml @@ -0,0 +1,192 @@ + + + + + + + + + + + + + + + + + + + + +]> + + + + 2.0 + TestProjectForRecreateConf + + + + VBA + {000204EF-0000-0000-C000-000000000046} + + + Excel + {00020813-0000-0000-C000-000000000046} + + + stdole + {00020430-0000-0000-C000-000000000046} + + + Office + {2DF8D04C-5BFA-101B-BDE5-00AA0044DE52} + + + MSForms + {0D452EE1-E08F-101A-852E-02608C4D0BB4} + + + Scripting + {420B2830-E718-11CF-893D-00A0C9054228} + + + VBIDE + {0002E157-0000-0000-C000-000000000046} + + + Shell32 + {50A7E9B0-70EF-11D1-B75A-00A0C90564FE} + + + MSXML2 + {F5078F18-C551-11D3-89B9-0000F81FE221} + + + ADODB + {00000206-0000-0010-8000-00AA006D2EA4} + + + VBAToolKit_DEV + C:\Documents and Settings\Demonn\Bureau\VBAToolKit\Project\VBAToolKit_DEV.xlsm + + + VBAToolKit + C:\Documents and Settings\Demonn\Application Data\Microsoft\AddIns\VBAToolKit.xlam + + + TestProject + TestProject.xlsm + ProjectName1 + Comment for Workbook #1 + + + TestProjectForRecreateConf_DEV + Project\TestProjectForRecreateConf_DEV.xlsm + ProjectName2 + Comment for Workbook #2 + + + TestProject_notExistingPathConf1 + testFolder1\TestProject_notExistingPathConf1.xlsm + ProjectName3 + Comment for Workbook #3 + + + TestProject_notExistingPathConf2 + testFolder1\testFolder2\TestProject_notExistingPathConf2.xlsm + ProjectName4 + Comment for Workbook #4 + + + TestProject_emptyConf + TestProject_emptyConf.xlsm + ProjectName5 + Comment for Workbook #5 + + + TestProject_normalConf + TestProject_normalConf.xlsm + Templates\TestProjectTemplate.xlsx + ProjectName6 + Comment for Workbook #6 + + + TestProject_xlamConf + TestProject_xlamConf.xlam + ProjectName7 + Comment for Workbook #7 + + + TestProject_xlsConf + TestProject_xlsConf.xls + ProjectName8 + Comment for Workbook #8 + + + TestProject_xlaConf + TestProject_xlaConf.xla + ProjectName9 + Comment for Workbook #9 + + + TestProject_multitypeConf + TestProject_multitypeConf.xlsm + ProjectName10 + Comment for Workbook #10 + + + TestProject_VTKConf + VBAToolKit.xlam + ProjectName11 + Comment for Workbook #11 + + + VBAToolKit + VBAToolKit.xlam + ProjectName12 + Comment for Workbook #12 + + + TestProject_NoTemplate + TestProject_normalConf.xlsm + Templates\NoTestProjectTemplate.xlsx + ProjectName13 + Comment for Workbook #13 + + + TestModule1 + TestModule1.bas + TestModule1.bas + TestModule1.bas + TestModule1.bas + TestModule1.bas + TestModule1.bas + TestModule1.bas + TestModule1.bas + TestModule1.bas + TestModule1.bas + TestModule1.bas + + + TestModule2 + TestModule2.bas + TestModule2.bas + TestModule2.bas + TestModule2.bas + TestModule2.bas + TestModule2.bas + TestModule2.bas + TestModule2.bas + TestModule2.bas + + + TestClassModule1 + TestClassModule1.cls + + + TestFormModule1 + TestFormModule1.frm + + diff --git a/Templates/TestProjectForRecreateConf_DEV.xlsm b/Templates/TestProjectForRecreateConf_DEV.xlsm index 0421949..41bc189 100644 Binary files a/Templates/TestProjectForRecreateConf_DEV.xlsm and b/Templates/TestProjectForRecreateConf_DEV.xlsm differ diff --git a/Templates/WorkBookForConfigurationsTests.xlsm b/Templates/WorkBookForConfigurationsTests.xlsm index 5ddc6fa..b8de282 100644 Binary files a/Templates/WorkBookForConfigurationsTests.xlsm and b/Templates/WorkBookForConfigurationsTests.xlsm differ diff --git a/Templates/XMLForConfigurationsTests.xml b/Templates/XMLForConfigurationsTests.xml new file mode 100644 index 0000000..282cd4c --- /dev/null +++ b/Templates/XMLForConfigurationsTests.xml @@ -0,0 +1,107 @@ + + + + + + + + + + + + + + + + + + + + +]> + + + + 2.0 + ExistingProject + + + + VBA + {000204EF-0000-0000-C000-000000000046} + + + Excel + {00020813-0000-0000-C000-000000000046} + + + stdole + {00020430-0000-0000-C000-000000000046} + + + Office + {2DF8D04C-5BFA-101B-BDE5-00AA0044DE52} + + + MSForms + {0D452EE1-E08F-101A-852E-02608C4D0BB4} + + + Scripting + {420B2830-E718-11CF-893D-00A0C9054228} + + + VBIDE + {0002E157-0000-0000-C000-000000000046} + + + Shell32 + {50A7E9B0-70EF-11D1-B75A-00A0C90564FE} + + + MSXML2 + {F5078F18-C551-11D3-89B9-0000F81FE221} + + + EventSystemLib + {4E14FB90-2E22-11D1-9964-00C04FBBB345} + + + VBAToolKit + C:\Documents and Settings\Demonn\Application Data\Microsoft\AddIns\VBAToolKit.xlam + + + ExistingProject + Delivery\ExistingProject.xlsm + ExistingProjectName + Existing project for various tests of VBAToolKit + + + ExistingProject_DEV + Project\ExistingProject_DEV.xlsm + Templates\ExistingProjectTemplate.xlsm + ExistingProject_DEV + Existing project for development for various tests of VBAToolKit + + + Module1 + Path1Module1 + + + Module2 + Path2Module2 + + + Module3 + + + Module4 + Path1Module4 + Path2Module4 + + + Module5 + Path2Module5 + +