'////////////////////////////////////  ((((((()))))))  \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

'  ScienSolar v. 1.6 MAIN MODULE 1. Updated 01-08-2025
'  © PhD Ariel R. Becerra B.

' Main changes in the new version:
' The ability to add buttons, combo boxes, drop-down lists, radio buttons, and check boxes to each individual project has been implemented.
' Improved tolerance for special characters, including mathematical symbols and characters for different languages, which can be written in any cell and will be exported correctly.
' Field mode display has been improved and some bugs have been fixed. The code has been debugged.
' For technical documentation, updates, or assistance, visit www.sciensolar.com.

'////////////////////////////////////  ((((((()))))))  \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

' ScienSolar package for modeling physics and mathematics in MS Excel (tested on MS Excel 2013-2019 for Windows and Mac).
' The package is distributed in 8 text files and must be integrated into an Excel file.
' By downloading the package you agree to the terms and conditions under the license GNU General Public License v.3.0 (https://www.gnu.org/licenses/gpl-3.0.html).
' You may use the ScienSolar package for free only under the terms of this license.

' Installation Instructions

' 1. Environment Setup
'   Open a new Excel workbook and access the VBA Editor (Windows: Alt + F11 | macOS: Fn + Option + F11).

' 2. Code Integration
'    In the VBAProject, insert six new modules.
'    Copy and paste each ScienSolar package file’s content into separate modules.

' 3. Initial Configuration
'    Create an execution button:
'    Navigate to the DEVELOPER tab > Controls group > select Insert > Button.
'    Place the button on the desired sheet and assign the NewSheet macro to it.

' 4. Project Launch
'    Click the button to start a new project.
'    To load a sample project, select it from the list and click the +Vector button.

' 5. Saving & Additional Resources
'    Save the workbook as a Macro-Enabled Workbook (*.xlsm) in your preferred location.
'    Note: Some projects require 3D objects or formulas from the 3D Models sheet. If missing, download and manually integrate it.

' 6. Creating New Projects
'    Click the New Sheet button to initialize a project workspace.
'    Add required vectors to the sheet using the New Vector button.
'    Modify parameters according to your specific model and mathematical equations.
'    Export the project code using the Code button.
'    Copy and paste the exported code into your workbook, then update the list in the CONFIG sheet.

'////////////////////////////////////  ((((((()))))))  \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

''Set variables
        Dim Y_abs As Single ' Excel horizontal point of origin of XYZ
        Dim Z_abs As Single ' Excel vertical point of origin of XYZ
        Dim A As Double ' Rotation angle about X
        Dim B As Double ' Rotation angle about Y
        Dim c As Double ' Rotation angle about Z
        Dim L As Double ' Axis lenght
        Dim Lx As Double 'The x component of a vector (that is, the value in cell A12 for the first vector)
        Dim Ly As Double 'The y component of a vector (that is, the value in cell B12 for the first vector)
        Dim Lz As Double 'The z component of a vector (that is, the value in cell C12 for the first vector)
        Dim Lox As Double 'The initial position in x of a vector (that is, the value in cell A10 for the first vector)
        Dim Loy As Double 'The initial position in y of a vector (that is, the value in cell A10 for the first vector)
        Dim Loz As Double 'The initial position in z of a vector (that is, the value in cell A10 for the first vector)
        Dim i As Double 'updated 07-2024
        
'Definition of general units of measurement
        Dim PatronW As Double ' The width of a cell will be taken as measure patron for other objects
        Dim PatronH As Double ' The height of a cell will be taken as measure patron for other objects
        Dim PatronT As Double  ' The top of a cell will be taken as measure patron for other objects
Sub Init()
'© 2022 A Becerra. ScienSolar.com
' Procedure aim: Create a new sheet with the ScienSolar interface.
' Segment Init-01. Command to avoid updating the sheet during execution.
        Application.ScreenUpdating = False
        ActiveWindow.DisplayGridlines = False

        
'Segment Init-02. Define coordinates relative to INICIO. The variables m and n relative to the initial position of the control board are introduced.
        Dim fila As Range ' This name will be a reference in the CONFIG sheet
        Dim m As Integer ' This is a reference number for starting point of rows in ScienSolar
        Dim n As Integer ' This is a reference number for starting point of columns in ScienSolar
        Set fila = ActiveSheet.Cells.Find(what:="INICIO")
        m = fila.Offset(1, 0).Row
        n = fila.Offset(1, 1).Column
        If Sheets("CONFIG").Cells(fila.Row + 31, fila.Column).Value = 1 Then ' 2025
            Call CheckIfProjectExists
        End If
        
'Segment Init-03. Define coordinates relative to LANGUAGE. Added 03.2024.
        Set fila = Sheets("CONFIG").Cells.Find(what:="(LENGUAJE)")
        If ActiveSheet.Cells(m - 1, n + 18).Value = "" Then
           ActiveSheet.Cells(m - 1, n + 18).Value = Sheets("CONFIG").Cells(fila.Row + 1, fila.Column).Value
        End If
        Sheets("CONFIG").Cells(fila.Row + 1, fila.Column).Value = ActiveSheet.Cells(m - 1, n + 18).Value
        Set fila = Nothing
        
'Segment Init-04. Clean the worksheet
        Cells.Delete
        DeleteObjects (8)
        DeleteObjects (17)
        
'Segment Init-05. Establish a general unit of length measurement within the sheet:
        PatronW = ActiveSheet.Cells(1, 1).Width
        PatronH = ActiveSheet.Cells(1, 2).Height
        
'Segment Init-06. Vector cell parameters and project title:
        Cells(m + 1, n + 1).Select
        With Selection
           .Value = "A"
           .Font.Bold = True
           .HorizontalAlignment = xlCenter
           .VerticalAlignment = xlBottom
        End With
        
'Segment Init-07. Add a project list:
        Dim lista As Range
        Set lista = Sheets("CONFIG").Cells.Find(what:="(LISTA)")
        m2 = lista.Offset(2, 0).Row
        n2 = lista.Column
        Set lista = Nothing
        ActiveSheet.DropDowns.Add(PatronW * (n + 14), PatronH * (m + 1), PatronW * 3, PatronH).Select
        With Selection
           .name = "List1"
           .LinkedCell = Cells(m + 1, n - 1).Address
           .DropDownLines = 20
           .Display3DShading = True
           .AddItem " " ' valor 1
            i = 0
            Do While Sheets("CONFIG").Cells(m2 + i, n2) <> ""
                .AddItem Sheets("CONFIG").Cells(m2 + i, n2 + 1).Value & " " & Sheets("CONFIG").Cells(m2 + i, n2).Value
                i = i + 1
            Loop
        End With
          
'Segment Init-08. Add a language list. 03.2024:
        Set lista = Sheets("CONFIG").Cells.Find(what:="LENGUAJE")
        m2 = lista.Offset(2, 0).Row
        n2 = lista.Column
        Set lista = Nothing
        ActiveSheet.DropDowns.Add(PatronW * (n + 17), PatronH * (m - 2), PatronW + 15, PatronH + 3).Select
        With Selection
           .name = "LangList"
           .LinkedCell = Cells(m - 1, n + 18).Address
           .DropDownLines = 20
           .Display3DShading = True
            i = 0
            Do While Sheets("CONFIG").Cells(m2 + i, n2) <> ""
                .AddItem Sheets("CONFIG").Cells(m2 + i, n2).Value
                i = i + 1
            Loop
        End With
        ActiveSheet.Cells(m - 1, n + 18).Value = Sheets("CONFIG").Cells(m2 - 1, n2).Value
        
'Segment Init-09. Add buttons to modify the view angles of the coordinate system:
        ActiveSheet.Spinners.Add(PatronW * (n + 4), PatronH * (m), PatronW / 4, PatronH).Select
        With Selection
           .Value = 0
           .SmallChange = 1
           .LinkedCell = Cells(m + 1, n + 5).Address
           .Display3DShading = True
        End With
        Selection.OnAction = "Rotate"
        ActiveSheet.Spinners.Add(PatronW * (n + 4), PatronH * (m + 1), PatronW / 4, PatronH).Select
        With Selection
           .Value = 0
           .SmallChange = 1
           .LinkedCell = Cells(m + 2, n + 5).Address
           .Display3DShading = True
        End With
        Selection.OnAction = "Rotate"
        ActiveSheet.Spinners.Add(PatronW * (n + 4), PatronH * (m + 2), PatronW / 4, PatronH).Select
        With Selection
           .Value = 0
           .SmallChange = 1
           .LinkedCell = Cells(m + 3, n + 5).Address
           .Display3DShading = True
        End With
        Selection.OnAction = "Rotate"
        
'Segment Init-10. Button to hide/show the control panel and help
        ActiveSheet.Buttons.Add(PatronW * (n + 15 / 2), PatronH * (m - 2), PatronW * 0.5, PatronH).Select
        Selection.name = Cells(m - 2, n - 1).Column
        Selection.OnAction = "ShowHideMenu"
        Selection.Characters.text = ChrW(9664)
        With Selection.Characters(Start:=1, Length:=3).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
           .ColorIndex = 1
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 17 / 2), PatronH * (m - 2), PatronW / 2, PatronH).Select
        Selection.OnAction = "HELP"
        Selection.Characters.text = " ? "
        With Selection.Characters(Start:=1, Length:=3).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 15
           .ColorIndex = 1
        End With
        
'Segment Init-11. General control panel buttons. See Characters.Text to identify the button.
        ActiveSheet.Buttons.Add(PatronW * (n + 2), PatronH * (m + 1), PatronW / 2, PatronH).Select
        Selection.name = "AutoSc"
        Selection.OnAction = "AutoScale"
        Selection.Characters.text = "Auto"
        With Selection.Characters(Start:=1, Length:=3).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n - 1), PatronH * (m - 1), PatronW / 2, PatronH).Select
        Selection.name = "AddButt"
        Selection.OnAction = "AddObject"
        Selection.Characters.text = "+ OBJ"
        With Selection.Characters(Start:=1, Length:=3).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n), PatronH * (m - 1), PatronW / 2, PatronH).Select
        Selection.name = "DelButt"
        Selection.OnAction = "AddObject"
        Selection.Characters.text = "- OBJ"
        With Selection.Characters(Start:=1, Length:=3).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 7 / 2), PatronH * (m - 1), PatronW / 2, PatronH).Select
        Selection.OnAction = "rotate"
        Selection.Characters.text = ""
        With Selection.Characters(Start:=1, Length:=3).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 4), PatronH * (m - 2), PatronW / 2, PatronH).Select
        Selection.OnAction = "rotate_XZY"
        Selection.Characters.text = "XYZ"
        With Selection.Characters(Start:=1, Length:=3).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 4), PatronH * (m - 1), PatronW / 2, PatronH).Select
        Selection.OnAction = "rotate_XY"
        Selection.Characters.text = "XY"
        With Selection.Characters(Start:=1, Length:=2).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 9 / 2), PatronH * (m - 1), PatronW / 2, PatronH).Select
        Selection.OnAction = "rotate_XZ"
        Selection.Characters.text = "XZ"
        With Selection.Characters(Start:=1, Length:=2).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 9 / 2), PatronH * (m - 2), PatronW / 2, PatronH).Select
        Selection.OnAction = "rotate_YZ"
        Selection.Characters.text = "YZ"
        With Selection.Characters(Start:=1, Length:=2).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 7 / 2), PatronH * (m), PatronW / 2, PatronH).Select
        Selection.OnAction = "rotate_A"
        Selection.Characters.text = ChrW(8811) & " A"
        With Selection.Characters(Start:=1, Length:=1).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 7 / 2), PatronH * (m + 1), PatronW / 2, PatronH).Select
        Selection.OnAction = "rotate_B"
        Selection.Characters.text = ChrW(8811) & " B"
        With Selection.Characters(Start:=1, Length:=1).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 7 / 2), PatronH * (m + 2), PatronW / 2, PatronH).Select
        Selection.OnAction = "rotate_C"
        Selection.Characters.text = ChrW(8811) & " C"
        With Selection.Characters(Start:=1, Length:=1).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 16), PatronH * (m - 2), PatronW, PatronH + 3).Select
        Selection.OnAction = "CleanSheet"
        Selection.Characters.text = Sheets("CONFIG").Range("B2").Value '"Restablecer"
        With Selection.Characters(Start:=1, Length:=11).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 13), PatronH * (m + 1), PatronW, PatronH).Select
        Selection.OnAction = "NewSheet"
        Selection.Characters.text = Sheets("CONFIG").Range("C2").Value
        With Selection.Characters(Start:=1, Length:=11).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 11), PatronH * (m + 1), PatronW, PatronH).Select
        Selection.name = "NewVector"
        Selection.OnAction = "AddNewVector"
        Selection.Characters.text = Sheets("CONFIG").Range("J2").Value
        With Selection.Characters(Start:=1, Length:=11).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 12), PatronH * (m + 1), PatronW / 3, PatronH).Select
        Selection.name = "NewVectorMinus"
        Selection.OnAction = "AddObject"
        Selection.Characters.text = " - "
        With Selection.Characters(Start:=1, Length:=11).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n - 2), PatronH * (m - 2), PatronW, PatronH).Select
        Selection.name = "ENTIRE"
        Selection.OnAction = "AddObject"
        Selection.Characters.text = Sheets("CONFIG").Range("K2").Value
        With Selection.Characters(Start:=1, Length:=11).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 7 / 2), PatronH * (m - 2), PatronW / 2, PatronH).Select
        Selection.OnAction = "XYZNeg"
        Selection.Characters.text = "-xyz"
        With Selection.Characters(Start:=1, Length:=3).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 3), PatronH * (m - 2), PatronW * 0.5, PatronH).Select
        Selection.OnAction = "BlackWhiteDesk"
        Selection.Characters.text = "B/W"
        With Selection.Characters(Start:=1, Length:=11).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 17), PatronH * (m + 1), PatronW, PatronH).Select
        Selection.name = "AddVector1"
        Selection.OnAction = "AddNewVector"
        Selection.Characters.text = "+  Vector"
        With Selection.Characters(Start:=1, Length:=11).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 7), PatronH * (m - 1), PatronW, PatronH).Select
        Selection.name = "ChangeParFrw"
        Selection.OnAction = "ChangeParameter"
        Selection.Characters.text = ChrW(8811) & Sheets("CONFIG").Range("J3").Value
        With Selection.Characters(Start:=1, Length:=11).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 7), PatronH * (m), PatronW, PatronH).Select
        Selection.name = "ChangeParBack"
        Selection.OnAction = "ChangeParameter"
        Selection.Characters.text = "<< " & Sheets("CONFIG").Range("J3").Value
        With Selection.Characters(Start:=1, Length:=11).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 9), PatronH * (m + 1), PatronW * 0.5, PatronH).Select
        Selection.OnAction = "rotate_Single"
        Selection.Characters.text = "->"
        With Selection.Characters(Start:=1, Length:=11).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 7.5), PatronH * (m + 1), PatronW * 0.5, PatronH).Select
        Selection.OnAction = "rotate_SingleBack"
        Selection.Characters.text = "<-"
        With Selection.Characters(Start:=1, Length:=11).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 9.5), PatronH * (m + 1), PatronW * 0.5, PatronH).Select
        Selection.OnAction = "rotate_End"
        Selection.Characters.text = "-->|"
        With Selection.Characters(Start:=1, Length:=11).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 8), PatronH * (m + 1), PatronW, PatronH).Select
        Selection.OnAction = "rotate_n"
        Selection.Characters.text = ChrW(8811) & Sheets("CONFIG").Range("K5").Value
        With Selection.Characters(Start:=1, Length:=11).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 9), PatronH * (m - 2), PatronW * 2, PatronH).Select
        Selection.OnAction = "About"
        Selection.Characters.text = "ScienSolar info"
        With Selection.Characters(Start:=1, Length:=11).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 12), PatronH * (m - 2), PatronW * 2, PatronH).Select
        Selection.OnAction = "ManualOnline"
        Selection.Characters.text = "Manual"
        With Selection.Characters(Start:=1, Length:=11).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 7), PatronH * (m + 1), PatronW * 0.5, PatronH).Select
        Selection.OnAction = "Reset"
        Selection.Characters.text = "|<--"
        With Selection.Characters(Start:=1, Length:=11).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n - 2) + 1, PatronH * (m), PatronW, PatronH).Select
        Selection.OnAction = "CreateCode"
        Selection.Characters.text = Sheets("CONFIG").Range("B3").Value
        With Selection.Characters(Start:=1, Length:=11).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        ActiveSheet.Buttons.Add(PatronW * (n + 19), PatronH * (m + 1), PatronW * 4, PatronH).Select
        Selection.name = "SplitText"
        Selection.OnAction = "SplitTextInTheory"
        Selection.Characters.text = Sheets("CONFIG").Range("J5").Value
        With Selection.Characters(Start:=1, Length:=11).Font
           .name = "Calibri"
           .FontStyle = "Normal"
           .Size = 11
        End With
        
'Segment Init-12. Give a format to the cells in the spreadsheet:
        Cells.Select
        With Selection.Interior
           .PatternColorIndex = xlAutomatic
           .ThemeColor = xlThemeColorLight1
           .TintAndShade = 0
           .PatternTintAndShade = 0
        End With
        With Selection.Font
           .ThemeColor = xlThemeColorDark1
           .TintAndShade = 0
        End With
        Range("A1:K1").Select
        With Selection.Borders(xlEdgeBottom)
           .LineStyle = xlContinuous
           .ThemeColor = 1
           .TintAndShade = -0.349986266670736
           .Weight = xlThick
        End With
        Range("K2:K5").Select
        With Selection.Borders(xlEdgeTop)
           .LineStyle = xlContinuous
           .ThemeColor = 1
           .TintAndShade = -0.349986266670736
           .Weight = xlThick
        End With
        With Selection.Borders(xlEdgeRight)
           .LineStyle = xlContinuous
           .ThemeColor = 1
           .TintAndShade = -0.349986266670736
           .Weight = xlThick
        End With
        Range("H5:K5").Select
        With Selection.Borders(xlEdgeBottom)
           .LineStyle = xlContinuous
           .ThemeColor = 1
           .TintAndShade = -0.349986266670736
           .Weight = xlThick
        End With
        With Selection.Borders(xlEdgeRight)
           .LineStyle = xlContinuous
           .ThemeColor = 1
           .TintAndShade = -0.349986266670736
           .Weight = xlThick
        End With
        Range("G6").Select
        With Selection.Borders(xlEdgeRight)
           .LineStyle = xlContinuous
           .ThemeColor = 1
           .TintAndShade = -0.349986266670736
           .Weight = xlThick
        End With
        Range("D6:G6").Select
        With Selection.Borders(xlEdgeBottom)
           .LineStyle = xlContinuous
           .ThemeColor = 1
           .TintAndShade = -0.349986266670736
           .Weight = xlThick
        End With
        With Selection.Borders(xlEdgeRight)
           .LineStyle = xlContinuous
           .ThemeColor = 1
           .TintAndShade = -0.349986266670736
           .Weight = xlThick
        End With
        Range("C5:C6").Select
        With Selection.Borders(xlEdgeRight)
           .LineStyle = xlContinuous
           .ThemeColor = 1
           .TintAndShade = -0.349986266670736
           .Weight = xlThick
        End With
        Range("A4:C4").Select
        With Selection.Borders(xlEdgeBottom)
           .LineStyle = xlContinuous
           .ThemeColor = 1
           .TintAndShade = -0.349986266670736
           .Weight = xlThick
        End With
        Range("A2:K4").Select
        With Selection.Interior
           .Pattern = xlSolid
           .PatternColorIndex = xlAutomatic
           .ThemeColor = xlThemeColorDark2
           .TintAndShade = 0
           .PatternTintAndShade = 0
        End With
        With Selection.Font
           .ThemeColor = xlThemeColorLight1
           .TintAndShade = 0
        End With
        Range("D5:J5").Select
        With Selection.Interior
           .Pattern = xlSolid
           .PatternColorIndex = xlAutomatic
           .ThemeColor = xlThemeColorDark2
           .TintAndShade = 0
           .PatternTintAndShade = 0
        End With
        With Selection.Font
           .ThemeColor = xlThemeColorLight1
           .TintAndShade = 0
        End With
        Range("D6:G6").Select
        With Selection.Interior
           .Pattern = xlSolid
           .PatternColorIndex = xlAutomatic
           .ThemeColor = xlThemeColorDark2
           .TintAndShade = 0
           .PatternTintAndShade = 0
        End With
        With Selection.Font
           .ThemeColor = xlThemeColorLight1
           .TintAndShade = 0
        End With
        
        Cells(m + 1, n + 9).Select
        With Selection.Interior
           .Pattern = xlSolid
           .PatternColorIndex = xlAutomatic
           .ThemeColor = xlThemeColorDark1
           .TintAndShade = -0.249977111117893
           .PatternTintAndShade = 0
        End With
        With Selection.Font
           .Size = 9
           .Color = -4165632
           .TintAndShade = 0
        End With
        ActiveCell.FormulaR1C1 = "S" & "c" & "i" & "e" & "n" _
        & "S" & "o" & "l" & "a" & "r" & " v" & 1 & ".55"
        Cells(m + 4, n + 2).Select
        With Selection.Font
           .Size = 12
           .Color = -4165632
           .TintAndShade = 0
           '.Bold = True
           .Italic = True
        End With
        Cells(m, n + 4).Select  'Label text color
        With Selection.Interior
           .Pattern = xlSolid
           .PatternColorIndex = xlAutomatic
           .ThemeColor = xlThemeColorLight2
           .TintAndShade = 0.399975585192419
           .PatternTintAndShade = 0
        End With
        Cells(m + 1, n + 4).Select ' X axis color
        With Selection.Interior
           .Pattern = xlSolid
           .PatternColorIndex = xlAutomatic
           .ThemeColor = xlThemeColorLight2
           .TintAndShade = 0.399975585192419
           .PatternTintAndShade = 0
        End With
        Cells(m + 2, n + 4).Select ' Y axis color
        With Selection.Interior
           .Pattern = xlSolid
           .PatternColorIndex = xlAutomatic
           .ThemeColor = xlThemeColorLight2
           .TintAndShade = 0.399975585192419
           .PatternTintAndShade = 0
        End With
        Cells(m + 3, n + 4).Select ' Z axis color
        With Selection.Interior
           .Pattern = xlSolid
           .PatternColorIndex = xlAutomatic
           .ThemeColor = xlThemeColorLight2
           .TintAndShade = 0.399975585192419
           .PatternTintAndShade = 0
        End With
        
'Segment Init-13.Set initial parameters for the control panel:
        Cells(m - 2, n + 2).Value = "        Rot XYZ:"
        Cells(m - 2, n + 3).Value = 8
        Cells(m - 2, n + 4).Value = 45
        Cells(m - 2, n + 5).FormulaR1C1 = "=RC[-2]*RC[-1]"
        Cells(m - 1, n - 1).Value = "INICIO"
        Cells(m - 1, n + 3).FormulaR1C1 = "=CONFIG!R2C4"
        Cells(m - 1, n + 6).FormulaR1C1 = "=CONFIG!R2C8"
        Cells(m - 1, n + 8).Value = 1
        Cells(m, n + 2).FormulaR1C1 = "=CONFIG!R3C4"
        Cells(m, n + 3).FormulaR1C1 = "=CONFIG!R3C5"
        Cells(m, n + 6).FormulaR1C1 = "=CONFIG!R3C8"
        Cells(m, n + 7).FormulaR1C1 = "=CONFIG!R3C9"
        Cells(m + 1, n + 2).FormulaR1C1 = "=CONFIG!R4C4"
        Cells(m + 1, n + 3).FormulaR1C1 = "=CONFIG!R4C5"
        Cells(m + 1, n + 6).FormulaR1C1 = "=CONFIG!R4C8"
        Cells(m + 1, n + 4).FormulaR1C1 = "=CONFIG!R4C6"
        Cells(m + 1, n + 5).FormulaR1C1 = "=CONFIG!R4C7"
        Cells(m + 1, n + 7).FormulaR1C1 = "=CONFIG!R4C9"
        Cells(m + 2, n + 2).FormulaR1C1 = "=CONFIG!R5C4"
        Cells(m + 2, n + 3).FormulaR1C1 = "=CONFIG!R5C5"
        Cells(m + 2, n + 4).FormulaR1C1 = "=CONFIG!R5C6"
        Cells(m + 2, n + 5).FormulaR1C1 = "=CONFIG!R5C7"
        Cells(m + 2, n + 6).FormulaR1C1 = "=CONFIG!R5C8"
        Cells(m + 2, n + 7).FormulaR1C1 = "=CONFIG!R5C9"
        Cells(m + 3, n + 2).FormulaR1C1 = "=CONFIG!R6C4"
        Cells(m + 3, n + 3).FormulaR1C1 = "=CONFIG!R6C5"
        Cells(m + 3, n + 4).FormulaR1C1 = "=CONFIG!R6C6"
        Cells(m + 3, n + 5).FormulaR1C1 = "=CONFIG!R6C7"
        Cells(m - 1, n + 2).Value = 2
        
'Segment Init-14. Restrict values to the INICIO cell:
        Range(Cells(m - 1, n - 1), Cells(m - 1, n - 1)).Select
        With Selection.Validation
           .Delete
           .Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="INICIO"
           .IgnoreBlank = True
           .InCellDropdown = True
           .InputTitle = "INICIO"
           .ErrorTitle = ""
           .InputMessage = "Only value INICIO is allowed."
           .ErrorMessage = "Only value INICIO is allowed."
           .ShowInput = True
           .ShowError = True
        End With
           
'Segment Init-15. Introducing a help comment
        ActiveSheet.Cells(m, n + 9).Value = "HELP"
        ActiveSheet.Cells(m, n + 9).AddComment
        ActiveSheet.Cells(m, n + 9).Comment.Visible = False
        ActiveSheet.Cells(m, n + 9).Comment.Shape.Width = 300
        ActiveSheet.Cells(m, n + 9).Comment.Shape.Height = 300
        ActiveSheet.Cells(m, n + 9).Comment.text text:= _
        "HELP Comment:" _
            & Chr(10) & _
        "1. To create new projects, press the +Vector button without selecting any project in the project list." _
            & Chr(10) & _
        "2. To load an existing project, select a project from the list and then press +Vector" _
            & Chr(10) & _
        "3. To export a new project, press the Get Code button. The code will be saved on your PC in the same directory where this file is located." _
            & Chr(10) & Chr(10) & _
        "If necessary, use this comment to create your own HELP comment for your project. To do this, simply replace this text with your own (Right Click, Edit Comment) and avoid special characters." _
            & Chr(10) & "After pressing Get Code, your comment will be updated and saved in the same txt file as your project and will be uploaded after the project appears in ScienSolar." _
            & "To include the new project in ScienSolar, perform the following steps:" _
            & Chr(10) & _
        "a) Open the txt file where the project was saved; " & _
        "b) copy all the contents of the file and paste it in the VBA Editor of the Excel file ScienSolar; " & _
        "c) add the project name and number to the list on the CONFIG sheet; " & _
        "d) Verify that the number is correlative and that it agrees with the project header number, if not modify it in the header or in the list as necessary." _
            & Chr(10) & _
        "Right click to delete or edit this comment." _
            & Chr(10) & Chr(10) & _
        "For documentation on ScienSolar, please visit www.sciensolar.com. ScienSolar was designed for 3D physics modeling in MS Excel." & _
        "It is normal that for some projects it takes time to load it in the sheet, it depends on the number of objects in your project and the performance of your PC."
        
        Cells(m + 1, n + 1).Select
    Application.ScreenUpdating = True
End Sub

Sub XYZ(ByVal m, n As Integer)
'© 2022 A Becerra. ScienSolar.com
'Segment XYZ-01. Define the point of the coordinate origin
    
    If Cells(m - 1, n + 4).Value = 1 Then
        Call XYZOpposite(m, n)
    End If
    
    If IsNumeric(ActiveSheet.Cells(m, n + 3).Value) Then
        Y_abs = ActiveSheet.Cells(m, n + 3).Value
    Else
        ActiveSheet.Cells(m, n + 3).Value = 850
        Y_abs = 850
    End If
    
    If IsNumeric(ActiveSheet.Cells(m + 1, n + 3).Value) Then
        Z_abs = ActiveSheet.Cells(m + 1, n + 3).Value
    Else
        ActiveSheet.Cells(m + 1, n + 3).Value = 400
        Z_abs = 400
    End If
    
     If IsNumeric(ActiveSheet.Cells(m + 3, n + 3).Value) Then
         L = ActiveSheet.Cells(m + 3, n + 3).Value  'Axles length
    Else
        ActiveSheet.Cells(m + 3, n + 3).Value = 200
        L = 200
    End If

'Segment XYZ-02. Define the angles of rotation of the axes:
    A = -ActiveSheet.Cells(m + 1, n + 5).Value * WorksheetFunction.Pi / 180   'angulo alrededor de X en radianes phi
    B = ActiveSheet.Cells(m + 2, n + 5).Value * WorksheetFunction.Pi / 180   'angulo alrededor de Y en radianes theta
    c = -ActiveSheet.Cells(m + 3, n + 5).Value * WorksheetFunction.Pi / 180   'angulo alrededor de Z en radianes alpha
   
'Segment XYZ-03. Define the variables for the dimensions and position of the axes in the spreadsheet
    Dim x_width As Double
    Dim y_width As Double
    Dim z_width As Double
    Dim x_height As Double
    Dim y_height As Double
    Dim z_height As Double
    Dim T_top
    Dim T_left
    Dim T_name
    Dim T_color As Double
    T_color = Cells(m, n + 4).Interior.Color

'Segment XYZ-04. Set the width and height of the Excel shapes that will represent the axes, according to the rotation matrix
    x_width = L * (Cos(A) * Sin(c) + Sin(A) * Cos(c) * Sin(B))
    x_height = L * (Sin(A) * Sin(c) - Cos(A) * Cos(c) * Sin(B))

    y_width = L * (Cos(A) * Cos(c) + Sin(A) * Sin(c) * Sin(B))
    y_height = L * (Sin(A) * Cos(c) + Cos(A) * Sin(c) * Sin(B))

    z_width = -L * Sin(A) * Cos(B)
    z_height = L * Cos(A) * Cos(B)

'Segment XYZ-05. Delete old labels and axes.
    If CheckExists("EjeX") = True Then
         ActiveSheet.Shapes("EjeX").Delete
    End If
    If CheckExists("EjeY") = True Then
         ActiveSheet.Shapes("EjeY").Delete
    End If
    If CheckExists("EjeZ") = True Then
         ActiveSheet.Shapes("EjeZ").Delete
    End If

'Segment XYZ-06. Delete other old objects
    DeleteObjects (17) ' 17 - for text boxes (labels), 1 -  for axes and vectors, 5- for free forms
    If CheckExists("campoHelp") = True Then '
        ActiveSheet.Shapes("campoHelp").Delete
    End If

'Segment XYZ-07. Create new axes as Excel shapes
    Dim Eje As Object
    Set Eje = ActiveSheet.Shapes.AddShape(msoShapeLineInverse, 787.2, 301.8, 1047, 304.2)
    Eje.name = "EjeX"
    Set Eje = ActiveSheet.Shapes.AddShape(msoShapeLineInverse, 787.2, 301.8, 1047, 304.2)
    Eje.name = "EjeY"
    Set Eje = ActiveSheet.Shapes.AddShape(msoShapeLineInverse, 787.2, 301.8, 1047, 304.2)
    Eje.name = "EjeZ"
    Set Eje = Nothing

'Segment XYZ-08. Correct the dimensions of the shapes that represent the X axis, due to their variation when rotating them.
    With ActiveSheet.Shapes("EjeX")
        If x_width < "0" Then
            .Width = -x_width
            .Left = Y_abs + x_width
            T_left = .Left
        Else
            .Width = x_width
            .Left = Y_abs
            T_left = .Left + x_width
            .Flip msoFlipHorizontal
        End If
        If x_height < "0" Then
            .Height = -x_height
            .Top = Z_abs
            T_top = .Top - x_height
        Else
            .Height = x_height
            .Top = Z_abs - x_height
             T_top = .Top
             .Flip msoFlipVertical
        End If
        .line.BeginArrowheadStyle = msoArrowheadTriangle
        .line.ForeColor.RGB = Cells(m + 1, n + 4).Interior.Color '
    End With

'Segment XYZ-09. Create X axis label
    T_label = ActiveSheet.Cells(m + 1, n + 4).Value
    T_name = ActiveSheet.Cells(m + 1, n + 4).Value
    Call CreateLabel(T_left, T_top, 0, 50, T_color, T_name, T_label)

'Segment XYZ-10. Do the same procedure above for the other two axes and labels
    With ActiveSheet.Shapes("EjeY")
        If y_width < "0" Then
            .Width = -y_width
            .Left = Y_abs + y_width
            T_left = .Left
        Else
            .Width = y_width
            .Left = Y_abs
            T_left = .Left + y_width
            .Flip msoFlipHorizontal
        End If
        If y_height < "0" Then
            .Height = -y_height
            .Top = Z_abs
            T_top = .Top - y_height
        Else
            .Height = y_height
            .Top = Z_abs - y_height
            T_top = .Top
            .Flip msoFlipVertical
        End If
        .line.BeginArrowheadStyle = msoArrowheadTriangle
        .line.ForeColor.RGB = Cells(m + 2, n + 4).Interior.Color
    End With
    T_label = ActiveSheet.Cells(m + 2, n + 4).Value
    T_name = ActiveSheet.Cells(m + 2, n + 4).Value
    Call CreateLabel(T_left, T_top, 0, 50, T_color, T_name, T_label)

    With ActiveSheet.Shapes("EjeZ")
        If z_width < "0" Then
            .Width = -z_width
            .Flip msoFlipHorizontal
            .Left = Y_abs + z_width
            T_left = .Left
        Else
            .Width = z_width
            .Left = Y_abs
            T_left = .Left + z_width
        End If
        If z_height < "0" Then
            .Flip msoFlipVertical
            .Height = -z_height
            .Top = Z_abs
            T_top = .Top - z_height
        Else
            .Height = z_height
            .Top = Z_abs - z_height
            T_top = .Top
        End If
        .line.EndArrowheadStyle = msoArrowheadTriangle
        .line.ForeColor.RGB = Cells(m + 3, n + 4).Interior.Color
    End With
    T_label = ActiveSheet.Cells(m + 3, n + 4).Value
    T_name = ActiveSheet.Cells(m + 3, n + 4).Value
    Call CreateLabel(T_left, T_top, 0, 50, T_color, T_name, T_label)
    
End Sub
Sub XYZNeg()
' Segment-XYZNeg-01. Enable negative axes of the coordinate system
    Dim m As Integer
    Dim n As Integer
    Set fila = ActiveSheet.Cells.Find(what:="INICIO")
    m = fila.Offset(1, 0).Row
    n = fila.Offset(1, 1).Column
    Set fila = Nothing
    
    If Cells(m - 1, n + 4).Value = 1 Then
        Cells(m - 1, n + 4).Value = 0
        If CheckExists("EjeXo") = True Then
             ActiveSheet.Shapes("EjeXo").Delete
        End If
        If CheckExists("EjeYo") = True Then
             ActiveSheet.Shapes("EjeYo").Delete
        End If
        If CheckExists("EjeZo") = True Then
             ActiveSheet.Shapes("EjeZo").Delete
        End If
    Else
        Cells(m - 1, n + 4).Value = 1
    End If
    
'Segment-XYZNeg-02. Update spreadsheet
    Rotate
End Sub
Sub XYZOpposite(ByVal m, n As Integer)
'© 2022 A Becerra. ScienSolar.com
'Parameters of the negative axes

'Segment XYZOpposite-01. Define the point of the coordinate origin
    If IsNumeric(ActiveSheet.Cells(m, n + 3).Value) Then
        Y_abs = ActiveSheet.Cells(m, n + 3).Value
    Else
        ActiveSheet.Cells(m, n + 3).Value = 850
        Y_abs = 850
    End If
    
    If IsNumeric(ActiveSheet.Cells(m + 1, n + 3).Value) Then
        Z_abs = ActiveSheet.Cells(m + 1, n + 3).Value
    Else
        ActiveSheet.Cells(m + 1, n + 3).Value = 400
        Z_abs = 400
    End If
    
     If IsNumeric(ActiveSheet.Cells(m + 3, n + 3).Value) Then
         L = ActiveSheet.Cells(m + 3, n + 3).Value  'longitud de los ejes
    Else
        ActiveSheet.Cells(m + 3, n + 3).Value = 200
        L = 200
    End If

'Segment XYZOpposite-02. Define the angles of rotation of the axes:
    A = -ActiveSheet.Cells(m + 1, n + 5).Value * WorksheetFunction.Pi / 180   'angulo alrededor de X en radianes phi
    B = ActiveSheet.Cells(m + 2, n + 5).Value * WorksheetFunction.Pi / 180   'angulo alrededor de Y en radianes theta
    c = -ActiveSheet.Cells(m + 3, n + 5).Value * WorksheetFunction.Pi / 180   'angulo alrededor de Z en radianes alpha
   
'Segment XYZOpposite-03. Define the variables for the dimensions and position of the objects in the spreadsheet
    Dim x_width As Double
    Dim y_width As Double
    Dim z_width As Double
    Dim x_height As Double
    Dim y_height As Double
    Dim z_height As Double

'Segment XYZOpposite-04. Set the width and height of the Excel shapes that will represent the axes, according to the rotation matrix
    x_width = -L * (Cos(A) * Sin(c) + Sin(A) * Cos(c) * Sin(B))
    x_height = -L * (Sin(A) * Sin(c) - Cos(A) * Cos(c) * Sin(B))

    y_width = -L * (Cos(A) * Cos(c) + Sin(A) * Sin(c) * Sin(B))
    y_height = -L * (Sin(A) * Cos(c) + Cos(A) * Sin(c) * Sin(B))

    z_width = L * Sin(A) * Cos(B)
    z_height = -L * Cos(A) * Cos(B)

'Segment XYZOpposite-05. Delete old labels and axes.
    If CheckExists("EjeXo") = True Then
         ActiveSheet.Shapes("EjeXo").Delete
    End If
    If CheckExists("EjeYo") = True Then
         ActiveSheet.Shapes("EjeYo").Delete
    End If
    If CheckExists("EjeZo") = True Then
         ActiveSheet.Shapes("EjeZo").Delete
    End If

'Segment XYZOpposite-06. Create new axes as Excel shapes
    Dim Eje As Object
    Set Eje = ActiveSheet.Shapes.AddShape(msoShapeLineInverse, 787.2, 301.8, 1047, 304.2)
    Eje.name = "EjeXo"
    Set Eje = ActiveSheet.Shapes.AddShape(msoShapeLineInverse, 787.2, 301.8, 1047, 304.2)
    Eje.name = "EjeYo"
    Set Eje = ActiveSheet.Shapes.AddShape(msoShapeLineInverse, 787.2, 301.8, 1047, 304.2)
    Eje.name = "EjeZo"
    Set Eje = Nothing

'Segment XYZOpposite-07. Correct the dimensions of the shapes that represent the X axis, due to their variation when rotating them.
    With ActiveSheet.Shapes("EjeXo")
        If x_width < "0" Then
            .Width = -x_width
            .Left = Y_abs + x_width
            T_left = .Left
        Else
            .Width = x_width
            .Left = Y_abs
            T_left = .Left + x_width
            .Flip msoFlipHorizontal
        End If
        If x_height < "0" Then
            .Height = -x_height
            .Top = Z_abs
            T_top = .Top - x_height
        Else
            .Height = x_height
            .Top = Z_abs - x_height
             T_top = .Top
             .Flip msoFlipVertical
        End If
        .line.Transparency = 0.3
        .line.DashStyle = 6
        .line.BeginArrowheadStyle = msoArrowheadTriangle
        .line.ForeColor.RGB = Cells(m + 1, n + 4).Interior.Color '
    End With

'Segment XYZOpposite-08. Do the same procedure above for the other two negative axes
    With ActiveSheet.Shapes("EjeYo")
        If y_width < "0" Then
            .Width = -y_width
            .Left = Y_abs + y_width
            T_left = .Left
        Else
            .Width = y_width
            .Left = Y_abs
            T_left = .Left + y_width
            .Flip msoFlipHorizontal
        End If
        If y_height < "0" Then
            .Height = -y_height
            .Top = Z_abs
            T_top = .Top - y_height
        Else
            .Height = y_height
            .Top = Z_abs - y_height
            T_top = .Top
            .Flip msoFlipVertical
        End If
        .line.Transparency = 0.3
        .line.DashStyle = 6
        .line.BeginArrowheadStyle = msoArrowheadTriangle
        .line.ForeColor.RGB = Cells(m + 2, n + 4).Interior.Color
    End With

    With ActiveSheet.Shapes("EjeZo")
        If z_width < "0" Then
            .Width = -z_width
            .Flip msoFlipHorizontal
            .Left = Y_abs + z_width
            T_left = .Left
        Else
            .Width = z_width
            .Left = Y_abs
            T_left = .Left + z_width
        End If
        If z_height < "0" Then
            .Flip msoFlipVertical
            .Height = -z_height
            .Top = Z_abs
            T_top = .Top - z_height
        Else
            .Height = z_height
            .Top = Z_abs - z_height
            T_top = .Top
        End If
        .line.Transparency = 0.3
        .line.DashStyle = 6
        .line.EndArrowheadStyle = msoArrowheadTriangle
        .line.ForeColor.RGB = Cells(m + 3, n + 4).Interior.Color
    End With

End Sub

Sub Field(ByVal m, n As Integer)
'© 2022 A Becerra. ScienSolar.com
'Procedure to display three-dimensional fields in the spreadsheet

'Segment Field-01. Declaration of variables
    ActiveSheet.Range("K6").Value = "" ' ' Clean the message: some vector were underscaled.
    ActiveSheet.Range("O6").Value = "" '  Clean the old min and max field values
    ActiveSheet.Range("P6").Value = ""
    ActiveSheet.Range("Q6").Value = ""
    ActiveSheet.Range("R6").Value = ""
    Dim T_color As Double  'Label text color
    Dim xS As Double ' Vector scale in the XYZ system
    Dim S As Long ' This indicates the number of each vector in a fiel formula. If a field has 900 vectors on the sheet, s goes from 1 to 900
    Dim flag As Boolean
    Dim SubField() As Integer ' Array for subfields
    Dim SubFieldN As Integer
    Dim VecHistFst As Integer, VecHistLst As Integer, VecNum As Integer
    Dim m1 As Integer, n1 As Integer
    Dim VecOutFlag As Boolean
    SubFieldN = 0
    VecOutFlag = True
    flag = False
    T_color = Cells(m, n + 4).Interior.Color
'    S = 1
    i = 0
    j = 1
    m1 = m
    n1 = n

    If IsNumeric(ActiveSheet.Cells(m + 2, n + 3).Value) Then
        xS = ActiveSheet.Cells(m + 2, n + 3).Value
    Else
        ActiveSheet.Cells(m + 2, n + 3).Value = 20
        xS = 20
    End If

    'Verify sub fields precense
    
    Do While ActiveSheet.Cells(m + 3 + i * 9, n - 1).Value <> ""
        'If Cells(m + 5 + i * 9, n + 1).Value < 1 Then ' if vector is not transparent
            ' Verify if SubFields are present. 21.05.2025
            If Application.WorksheetFunction.And( _
                Cells(m + 4 + i * 9, n + 1).Value <> "", _
                Cells(m + 10 + i * 9, n).Value < 0, _
                Cells(m + 11 + i * 9, n).Value < 0) Then
                SubFieldN = SubFieldN + 1
                ReDim Preserve SubField(SubFieldN)
                SubField(SubFieldN) = m + i * 9
                Range("M3").Value = "Nubes: "
                Range("N3").Value = SubFieldN
                flag = True
            End If
        'End If
        i = i + 1
        j = j + 1
    Loop
    
'Segment Field-02. Do while there are vectors in the spreadsheet.
    Do While Cells(m + 3, n - 1).Value <> ""
    S = 1
 
'Segment Field-03. Clean old vectors in the spreadsheet
        If Cells(m + 5, n - 1).Value > 1000 Then  ' If the number of vectors is >2000, they disappear instantly:
            Call DeleteObjects(1)
            Call DeleteObjects(30)
            Call XYZ(m1, n1)
        ElseIf Cells(m + 4, n + 1).Value <> "" Then 'clean clouds if exist
            Dim forma As Shape
            Dim nombreForma As String
            Dim prefijo As String
            Dim contador As Integer
            prefijo = "campo" & Cells(m + 3, n - 1).Value
repaso:
            contador = 0
            For i = 1 To ActiveSheet.Shapes.Count Step 1
                On Error Resume Next
                Set forma = ActiveSheet.Shapes(i)
                nombreForma = forma.name
                ' Check if the name begins with campo prefix
                If Left(nombreForma, Len(prefijo)) = prefijo Then
                    forma.Delete
                    contador = contador + 1
                End If
            Next i
            If contador > 0 Then GoTo repaso

        Else
            'if the number of vector is small, they gradually disappear:
            VecHistFst = Cells(m + 10, n + 1).Value
            VecHistLst = Cells(m + 5, n - 1).Value
            VecNum = Cells(m + 3, n - 1).Value
            i = 0
            For i = VecHistFst To VecHistLst ' deja un vector sin eliminar (el indicado en la celda)
                On Error Resume Next
                ActiveSheet.Shapes("campo" & VecNum & "_" & 0).Delete
                ActiveSheet.Shapes("campo" & VecNum & "_" & 1).Delete ' Updated Dec 2023
                ActiveSheet.Shapes("campo" & VecNum & "_" & i).Delete
            Next i
        End If

'Segment Field-03a. Clean cells for sum of coordinates of a field. 16.05.2025
    If Application.WorksheetFunction.And(Cells(m + 4, n + 1).Value <> "", Cells(m + 10, n).Value < 0, Cells(m + 11, n).Value < 0) Then
        flag = True
        ActiveSheet.Cells(m + 6, n - 1).Value = ""
        ActiveSheet.Cells(m + 6, n).Value = ""
        ActiveSheet.Cells(m + 6, n + 1).Value = ""
    End If

'Segment Field-04. Verifyif that the vector has 3D objects
        If Cells(m + 4, n).Value = 200 Then Cells(m + 5, n + 1).Value = 2 ' This property is to enable 3D Excel Models (stored in 3DModels spreadsheet)

'Segment Field-05. Display vectors in the XYZ system:
        If Cells(m + 3, n - 1).Value > 0 And Cells(m + 5, n + 1).Value <> 1 Then   ' These conditions apply to the vectors that will be displayed
            Dim cod As Integer ' Define the type of Excel shape that will represent the vector
            cod = Cells(m + 4, n).Value

'Segment Field-06. Output data to a table when simulating. If the cell value is zero, no data will be displayed
            If Cells(m + 10, n).Value > 0 And Cells(m + 11, n).Value > 0 Then
                Call DataOutput(m, n) ' Display data in a table.
            End If

'Segment Field-07. The following condition allows us to display a field function in a region of XYZ as a set of vectors.
            If ActiveSheet.Cells(m + 4, n + 1).Value <> "" Then ' If not empty, is a field; if empty is a single vector.
                If ActiveSheet.Cells(m + 4, n + 1).FormulaR1C1 = 1 Then
                    ActiveSheet.Cells(m + 4, n + 1).FormulaR1C1 = ""
                    GoTo sig
                End If
                If ActiveSheet.Cells(m + 4, n + 1).FormulaR1C1 = 0 Then
                    ActiveSheet.Cells(m + 4, n + 1).FormulaR1C1 = ""
                    GoTo sig
                End If

                'Insert in C7 (or similar) a slice bar to graduate the color of the field. v.1.55. 2025
                If ActiveSheet.Cells(m + 3, n + 1).Value = "" Then ' if color cell is free
                    Cells(m + 3, n + 1).Value = 15 'default color palette blue to red
                    Cells(m + 3, n + 1).Select
                        With Selection.Font
                            .name = "Calibri"
                            .FontStyle = "Normal"
                            .Size = 14
                            .ThemeColor = xlThemeColorDark1
                            .TintAndShade = 0
                            .ThemeFont = xlThemeFontNone
                        End With
                        With Selection.Interior
                            .Pattern = xlGrid
                            .PatternColorIndex = xlAutomatic
                            .ThemeColor = xlThemeColorAccent5
                            .TintAndShade = 0
                            .PatternTintAndShade = 0
                        End With
                         ActiveSheet.Cells(m + 4, n + 1).AddComment
                        ActiveSheet.Cells(m + 4, n + 1).Comment.Visible = False
                        ActiveSheet.Cells(m + 4, n + 1).Comment.Shape.Width = 300
                        ActiveSheet.Cells(m + 4, n + 1).Comment.Shape.Height = 300
                        ActiveSheet.Cells(m + 4, n + 1).Comment.text text:="Field mode:" & Chr(10) & Chr(10) & "1. For spherical coordinates, cell value = s" _
                        & Chr(10) & "2. For cylindrical coordinates, cell value = c" _
                        & Chr(10) & "3. For Cartesian coordinates, cell value = o" _
                        & Chr(10) & Chr(10) & "Then set the parameters to the string that appeared in this cell." _
                        & Chr(10) & "The first parenthesis [ ] indicates the step of increasing coordinates, " _
                        & "the next three parentheses [ ] indicate the range of each of the three coordinates, " _
                        & "the higher the range, the longer the rendering time; " _
                        & "the color parameter is used to color the vector according to its length, the number indicating approximately the length of the largest vector, " _
                        & "the color is distributed between red (smaller vector) and violet (larger vector)." _
                        & "The last parenthesis [ ] indicates the origin of the coordinates, where vector distributions begin." _
                        & Chr(10) & Chr(10) & "Use the parameter value color=[0] to get a single color, which will be the color of the color cell (above)" _
                        & Chr(10) & Chr(10) & "Enter a number from 15 to 100 in the color cell (above) to choose different color palettes. " _
                        & Chr(10) & Chr(10) & "Please enclose only numeric values between semicolons, do not modify the structure of this string, except if you are an expert in MS Excel." _
                        & Chr(10) & Chr(10) & "To return to single vector mode, clear the contents of this cell." _
                        & Chr(10) & Chr(10) & "Right-click to remove this comment."
                 End If

                ' Set origin by default and automatically according to the dimensions of the current vectors:
                'Collect current vector coordinate data and verify if SubFields are present:

            'Choose the coordinate system indicated by the user (s, c, f or o)
            Select Case Left(ActiveSheet.Cells(m + 4, n + 1).Value, 1)
                Case "s"
                    Call ProcessSphericalCoordinates(m, n, S, cod, xS, T_color, flag, SubField(), SubFieldN, VecOutFlag)
                Case "c"
                    Call ProcessCylindricalCoordinates(m, n, S, cod, xS, T_color, flag, SubField(), SubFieldN, VecOutFlag)
                Case "f"
                    Call ProcessFibonacciCoordinates(m, n, S, cod, xS, T_color, flag, SubField(), SubFieldN, VecOutFlag)
                Case "o"
                    Call ProcessCartesianCoordinates(m, n, S, cod, xS, T_color, flag, SubField(), SubFieldN, VecOutFlag)
            End Select

sig:
    'Segment Field-08. Here the option to show field ends and the option to show a single vector begins
            Else
                S = 1
                Call VectorOutput(m, n, S, cod, Y_abs, Z_abs, xS, T_color)
            End If

'Segment field-09. Fix s (vector inside a field)
        Cells(m + 5, n - 1).Value = S
        End If

        m = m + 9 ' Next vector of the spreadsheet in the first 3 columns.
    Loop
End Sub
Private Sub ExtractParameters( _
    ByRef CoordLetter As String, _
    ByVal m As Integer, ByVal n As Integer, _
    ByRef NLine As Double, ByRef NLine2 As Double, ByRef NLine3 As Double, _
    ByRef Nline0x As Double, ByRef Nlinex As Double, _
    ByRef Nline0y As Double, ByRef Nliney As Double, _
    ByRef Nline0z As Double, ByRef Nlinez As Double, _
    ByRef tfactor As Double, _
    ByRef x_0 As Double, ByRef y_0 As Double, ByRef z_0 As Double, _
    ByRef xS As Double)
    
'Segment ExtractParameters -01. Define variables
    Dim Atemp As Long, Btemp As Long, Ctemp As Long
    Dim A() As Double, B() As Double, c() As Double ' Properly typed arrays
    Dim Centery As Double, Centerx As Double, Centerz As Double
    Dim FirstName As String, SecondName As String, ThirdName As String
    Dim FirstNameLen As Integer, SecondNameLen As Integer, ThirdNameLen As Integer
    Atemp = 0
    Btemp = 0
    Ctemp = 0
    
    On Error Resume Next
    If CoordLetter = "s" Then
        FirstName = "r"
        SecondName = "phi"
        ThirdName = "theta"
    ElseIf CoordLetter = "f" Then
        FirstName = "r"
        SecondName = "phi"
        ThirdName = "theta"
    ElseIf CoordLetter = "c" Then
        FirstName = "rho"
        SecondName = "phi"
        ThirdName = "z"
    ElseIf CoordLetter = "o" Then
        FirstName = "x"
        SecondName = "y"
        ThirdName = "z"
    End If
   
'Segment ExtractParameters -01. Verify if the parameters were not stablished by the user and, if not, set default parameters
    If WorksheetFunction.Or( _
    InStr(ActiveSheet.Cells(m + 4, n + 1).Value, FirstName & "=") = 0, _
    InStr(ActiveSheet.Cells(m + 4, n + 1).Value, SecondName & "=") = 0, _
    InStr(ActiveSheet.Cells(m + 4, n + 1).Value, ThirdName & "=") = 0) Then
              
        ' Default parameters
        If CoordLetter = "s" Then
            If L / xS < 1 Then
                Nlinex = Round(L / (2 * xS), InStr(InStr(L / (2 * xS), ","), L / (2 * xS), "0", 0) + 1)
            Else
                Nlinex = Round(L / (2 * xS), 0)
            End If
            NLine = Nlinex / 10
            NLine2 = 10
            NLine3 = 10
            Nline0x = Nlinex
            Nline0y = 0
            Nline0z = 0
            Nliney = 360
            Nlinez = 180
        ElseIf CoordLetter = "f" Then
            If L / xS < 1 Then
            Nlinex = Round(L / (2 * xS), InStr(InStr(L / (2 * xS), ","), L / (2 * xS), "0", 0) + 1)
            Else
                Nlinex = Round(L / (2 * xS), 0)
            End If
            NLine = Nlinex / 10
            NLine2 = 20
            NLine3 = 20
            Nline0x = Nlinex
            Nline0y = 0
            Nline0z = 0
            Nliney = 360
            Nlinez = 180
        ElseIf CoordLetter = "c" Then
            If L / xS < 1 Then
                Nlinex = Round(L / (xS), InStr(InStr(L / (xS), ","), L / (xS), "0", 0) + 1)
            Else
                Nlinex = Round(L / (xS), 0)
            End If
            NLine = Nlinex / 5
            NLine2 = 10
            NLine3 = Nlinex / 5
            Nline0x = Nlinex / 3
            Nline0y = 0
            Nline0z = 0
            Nliney = 360
            Nlinez = Nlinex / 2
        ElseIf CoordLetter = "o" Then
            If L / xS < 1 Then
                Nliney = Round(L / (xS), InStr(InStr(L / (xS), ","), L / (xS), "0", 0) + 1)
            Else
                Nliney = Round(L / (xS), 0)
            End If
            NLine = Nliney / 20
            NLine2 = Nliney / 20
            NLine3 = Nliney / 20
            Nline0x = 0
            Nline0y = -Nliney
            Nline0z = -Nliney
            Nlinex = 0
            Nlinez = Nliney
        End If
        
        i = 0
        j = 0
        
'Segment ExtractParameters -02. Displacement of the coordinate system
        Do While ActiveSheet.Cells(m + 3 + i * 9, n - 1).Value <> ""
            If Cells(m + 5 + i * 9, n + 1).Value < 1 Then ' if vector is not transparent
                ReDim Preserve A(j + 5)
                A(j) = Cells(m + 7 + i * 9, n - 1).Value
                ReDim Preserve B(j + 5)
                B(j) = Cells(m + 7 + i * 9, n).Value
                ReDim Preserve c(j + 5)
                c(j) = Cells(m + 7 + i * 9, n + 1).Value
            End If
            i = i + 1
            j = j + 1
        Loop
        Centerx = WorksheetFunction.Average(A)
        Centery = WorksheetFunction.Average(B)
        Centerz = WorksheetFunction.Average(c)
        Erase A
        Erase B
        Erase c

'Segment ExtractParameters -03. Put default parameters to display the field:
        ActiveSheet.Cells(m + 4, n + 1).FormulaR1C1 = CoordLetter & "[" & NLine & "]" & FirstName & "=[" & Nline0x & ";" & Nlinex & "]" & CoordLetter & "2[" & NLine2 & "]" & SecondName & "=[" & Nline0y & ";" & Nliney & _
        "]" & CoordLetter & "3[" & NLine3 & "]" & ThirdName & "=[" & Nline0z & ";" & Nlinez & "]color=[" & Nlinex + Nliney + Nlinez & "]origin[cart.]=[" & Centerx & ";" & Centery & ";" & Centerz & "]FieldLayers[0]FieldLayersRange=[0;0]LayerThickness=[1]tfactor=0,008s"

        'Regulate the length of all the vectors of the field.
        ActiveSheet.Cells(m + 5, n).Value = "60*1" ' regulador de longitudes

        'Modify the initial coordinate formulas.
        ActiveSheet.Cells(m + 7, n - 1).FormulaR1C1 = "=R[1]C"
        ActiveSheet.Cells(m + 7, n).FormulaR1C1 = "=R[1]C"
        ActiveSheet.Cells(m + 7, n + 1).FormulaR1C1 = "=R[1]C"
    End If

'Segment ExtractParameters -04. Read the parameters introduced by the user
    Atemp = InStr(ActiveSheet.Cells(m + 4, n + 1).Value, CoordLetter & "[") + 2
    Btemp = InStr(Atemp, ActiveSheet.Cells(m + 4, n + 1).Value, "]")
    NLine = CDbl(Mid(ActiveSheet.Cells(m + 4, n + 1).Value, Atemp, Btemp - Atemp))
    
    Atemp = InStr(ActiveSheet.Cells(m + 4, n + 1).Value, CoordLetter & "2[") + 3
    Btemp = InStr(Atemp, ActiveSheet.Cells(m + 4, n + 1).Value, "]")
    NLine2 = CDbl(Mid(ActiveSheet.Cells(m + 4, n + 1).Value, Atemp, Btemp - Atemp))
    
    Atemp = InStr(ActiveSheet.Cells(m + 4, n + 1).Value, CoordLetter & "3[") + 3
    Btemp = InStr(Atemp, ActiveSheet.Cells(m + 4, n + 1).Value, "]")
    NLine3 = CDbl(Mid(ActiveSheet.Cells(m + 4, n + 1).Value, Atemp, Btemp - Atemp))

    ' Read the coordinate system ranges
    Atemp = InStr(ActiveSheet.Cells(m + 4, n + 1).Value, FirstName & "=") + Len(FirstName) + 2
    Btemp = InStr(Atemp, ActiveSheet.Cells(m + 4, n + 1).Value, ";")
    Nline0x = Mid(ActiveSheet.Cells(m + 4, n + 1).Value, Atemp, Btemp - Atemp)
    Atemp = InStr(Btemp, ActiveSheet.Cells(m + 4, n + 1).Value, "]")
    Nlinex = Mid(ActiveSheet.Cells(m + 4, n + 1).Value, Btemp + 1, Atemp - Btemp - 1)
    
    Atemp = InStr(ActiveSheet.Cells(m + 4, n + 1).Value, SecondName & "=") + Len(SecondName) + 2
    Btemp = InStr(Atemp, ActiveSheet.Cells(m + 4, n + 1).Value, ";")
    Nline0y = Mid(ActiveSheet.Cells(m + 4, n + 1).Value, Atemp, Btemp - Atemp)
    Atemp = InStr(Btemp, ActiveSheet.Cells(m + 4, n + 1).Value, "]")
    Nliney = Mid(ActiveSheet.Cells(m + 4, n + 1).Value, Btemp + 1, Atemp - Btemp - 1)
    
    Atemp = InStr(ActiveSheet.Cells(m + 4, n + 1).Value, ThirdName & "=") + Len(ThirdName) + 2
    Btemp = InStr(Atemp, ActiveSheet.Cells(m + 4, n + 1).Value, ";")
    Nline0z = Mid(ActiveSheet.Cells(m + 4, n + 1).Value, Atemp, Btemp - Atemp)
    Atemp = InStr(Btemp, ActiveSheet.Cells(m + 4, n + 1).Value, "]")
    Nlinez = Mid(ActiveSheet.Cells(m + 4, n + 1).Value, Btemp + 1, Atemp - Btemp - 1)
    
    ' Read the system origin parameters and time
    Atemp = InStr(ActiveSheet.Cells(m + 4, n + 1).Value, "tfactor=") + 8
    Btemp = InStr(Atemp, ActiveSheet.Cells(m + 4, n + 1).Value, "s")
    tfactor = Mid(ActiveSheet.Cells(m + 4, n + 1).Value, Atemp, Btemp - Atemp)
    
    Atemp = InStr(ActiveSheet.Cells(m + 4, n + 1).Value, "origin[cart.]=") + 15
    Btemp = InStr(Atemp, ActiveSheet.Cells(m + 4, n + 1).Value, ";")
    x_0 = CDbl(Mid(ActiveSheet.Cells(m + 4, n + 1).Value, Atemp, Btemp - Atemp))
    Atemp = Btemp + 1
    Btemp = InStr(Atemp, ActiveSheet.Cells(m + 4, n + 1).Value, ";")
    y_0 = CDbl(Mid(ActiveSheet.Cells(m + 4, n + 1).Value, Atemp, Btemp - Atemp))
    Atemp = Btemp + 1
    Btemp = InStr(Atemp, ActiveSheet.Cells(m + 4, n + 1).Value, "]")
    z_0 = CDbl(Mid(ActiveSheet.Cells(m + 4, n + 1).Value, Atemp, Btemp - Atemp))
End Sub

Private Sub ProcessSphericalCoordinates( _
    ByVal m As Integer, ByVal n As Integer, _
    ByRef S As Long, ByVal cod As Integer, _
    ByVal xS As Double, ByVal T_color As Double, _
    ByRef flag As Boolean, ByRef SubField() As Integer, _
    ByRef SubFieldN As Integer, ByRef VecOutFlag As Boolean)

'Segment ProcessSphericalCoordinates -01. Define variables
    Dim NLine As Double, NLine2 As Double, NLine3 As Double
    Dim x_0 As Double, y_0 As Double, z_0 As Double
    Dim Nline0x As Double, Nline0y As Double, Nline0z As Double
    Dim Nlinex As Double, Nliney As Double, Nlinez As Double
    Dim tfactor As Double, t As Single, Bulk As Double
    Dim msg As String, Response As VbMsgBoxResult
    Dim i As Double, j As Double, k As Double, sf As Integer

    Dim SumX As Double, SumY As Double, SumZ As Double
    SumX = 0
    SumY = 0
    SumZ = 0

    On Error Resume Next
    Call ExtractParameters("s", m, n, NLine, NLine2, NLine3, _
                                  Nline0x, Nlinex, Nline0y, Nliney, Nline0z, Nlinez, _
                                  tfactor, x_0, y_0, z_0, xS)

'Segment ProcessSphericalCoordinates -02. Calculate aprox the number of vectors (points) that will be placed in the spreadsheet
    Dim totalPoints As Integer
    totalPoints = 0
    If NLine = 0 Then NLine = 1
    If NLine2 = 0 Then NLine2 = 1
    If NLine3 = 0 Then NLine3 = 1
    totalPoints = CInt(((Nlinex - Nline0x) / NLine + 1) * _
                  ((Nliney - Nline0y) / NLine2 + 1) * _
                  ((Nlinez - Nline0z) / NLine3 + 1))

     ' Alert if the number of vectors is large
     msg = totalPoints & " points will be generated." & vbCrLf & _
      "Estimated time: " & Round((totalPoints * tfactor + 15) / 60, 1) & " minutes. Proceed?"

    If Round((totalPoints * tfactor) / 60, 1) > 0.5 Then
        Response = MsgBox(msg, vbYesNo, "Confirmation")
        If Response = vbNo Then Exit Sub
    End If

'Segment ProcessSphericalCoordinates -03. Process the spreadsheet range of the field

    ' Start timelapse
    t = Timer
    Cells(m + 5, n - 1).Value = totalPoints
    
        'Display the field in the coordinate system (display it in spherical coordinates)
            For i = Nline0x To Nlinex Step NLine
                For j = Nline0y To Nliney Step NLine2
                    For k = Nline0z To Nlinez Step NLine3
                        On Error Resume Next
                        ActiveSheet.Cells(m + 8, n - 1).Value = i * Cos(WorksheetFunction.Radians(j)) * Sin(WorksheetFunction.Radians(k)) + x_0
                        ActiveSheet.Cells(m + 8, n).Value = i * Sin(WorksheetFunction.Radians(j)) * Sin(WorksheetFunction.Radians(k)) + y_0
                        ActiveSheet.Cells(m + 8, n + 1).Value = i * Cos(WorksheetFunction.Radians(k)) + z_0
'                        DoEvents ' Activate this to enable stop during simulation. The execution time increases significantly.
                       
                        'Code to calculate the field in each point, according to formula of the cells m+9 (in the spreadsheet) and put in cells m+6 the resulting sum in eacha axis
                        'If the sum is not desidered, change the SumX, SumY and SumZ formulas below. These are lines of code for a subfield within the main field.
                        If flag = True And Cells(m + 10, n) > -1 Then
                            For sf = 1 To SubFieldN
                                If SubField(sf) <> m And VecOutFlag = True Then
                                    'S = 1
                                    VecOutFlag = False
                                    Select Case Left(ActiveSheet.Cells(SubField(sf) + 4, n + 1).Value, 1)
                                        Case "s"
                                            Call ProcessSphericalCoordinates(SubField(sf), n, S, cod, xS, T_color, flag, SubField(), SubFieldN, VecOutFlag)
                                        Case "c"
                                            Call ProcessCylindricalCoordinates(SubField(sf), n, S, cod, xS, T_color, flag, SubField(), SubFieldN, VecOutFlag)
                                        Case "f"
                                            Call ProcessFibonacciCoordinates(SubField(sf), n, S, cod, xS, T_color, flag, SubField(), SubFieldN, VecOutFlag)
                                        Case "o"
                                            Call ProcessCartesianCoordinates(SubField(sf), n, S, cod, xS, T_color, flag, SubField(), SubFieldN, VecOutFlag)
                                    End Select
                                    VecOutFlag = True
                                End If
                            Next sf
                        Else
                            SumX = SumX + ActiveSheet.Cells(m + 9, n - 1).Value ' * 74 When values are very small (<10 -15), VBA is less accurate than Excel,
                            SumY = SumY + ActiveSheet.Cells(m + 9, n).Value ' * 74 so, try to multiplicate by 74
                            SumZ = SumZ + ActiveSheet.Cells(m + 9, n + 1).Value ' * 74
                        End If
                        
                        If VecOutFlag = True Then
                            Call VectorOutput(m, n, S, cod, Y_abs, Z_abs, xS, T_color) 'Put each vector in XYZ
                       End If
                        If Abs(Cells(m + 10, n).Value) > 3 And Abs(Cells(m + 11, n).Value) > 3 Then
                            Call DataOutput(m, n)
                        End If
                        S = S + 1 ' next vector
                    Next k
                Next j
            Next i
            If WorksheetFunction.Or( _
            Left(ActiveSheet.Cells(m + 6, n - 1).FormulaR1C1, 1) <> "=", _
            Left(ActiveSheet.Cells(m + 6, n).FormulaR1C1, 1) <> "=", _
            Left(ActiveSheet.Cells(m + 6, n + 1).FormulaR1C1, 1) <> "=") Then
                ActiveSheet.Cells(m + 6, n - 1).Value = SumX
                ActiveSheet.Cells(m + 6, n).Value = SumY
                ActiveSheet.Cells(m + 6, n + 1).Value = SumZ
            End If
End Sub

Private Sub ProcessCylindricalCoordinates( _
    ByVal m As Integer, ByVal n As Integer, _
    ByRef S As Long, ByVal cod As Integer, _
    ByVal xS As Double, ByVal T_color As Double, _
    ByRef flag As Boolean, ByRef SubField() As Integer, _
    ByRef SubFieldN As Integer, ByRef VecOutFlag As Boolean)

'Segment ProcessCylindricalCoordinates -01. Define variables
    Dim NLine As Double, NLine2 As Double, NLine3 As Double
    Dim x_0 As Double, y_0 As Double, z_0 As Double
    Dim Nline0x As Double, Nline0y As Double, Nline0z As Double
    Dim Nlinex As Double, Nliney As Double, Nlinez As Double
    Dim tfactor As Double, t As Single, Bulk As Double
    Dim msg As String, Response As VbMsgBoxResult
    Dim i As Double, j As Double, k As Double, sf As Integer
    Dim SumX As Double, SumY As Double, SumZ As Double
    SumX = 0
    SumY = 0
    SumZ = 0

    On Error Resume Next
    
' Extract parameters
    Call ExtractParameters("c", m, n, NLine, NLine2, NLine3, _
                                  Nline0x, Nlinex, Nline0y, Nliney, Nline0z, Nlinez, _
                                  tfactor, x_0, y_0, z_0, xS)

'Segment ProcessCylindricalCoordinates -02. Calculate aprox the number of vectors (points) that will be placed in the spreadsheet
    Dim totalPoints As Integer
    totalPoints = 0
    If NLine = 0 Then NLine = 1
    If NLine2 = 0 Then NLine2 = 1
    If NLine3 = 0 Then NLine3 = 1
    totalPoints = CInt(((Nlinex - Nline0x) / NLine + 1) * _
                  ((Nliney - Nline0y) / NLine2 + 1) * _
                  ((Nlinez - Nline0z) / NLine3 + 1))

     ' Alert if the number of vectors is large
     msg = totalPoints & " points will be generated." & vbCrLf & _
      "Estimated time: " & Round((totalPoints * tfactor + 15) / 60, 1) & " minutes. Proceed?"

    If Round((totalPoints * tfactor) / 60, 1) > 0.5 Then
        Response = MsgBox(msg, vbYesNo, "Confirmation")
        If Response = vbNo Then Exit Sub
    End If

'Segment ProcessCylindricalCoordinates -03. Process the spreadsheet range of the field
    ' Start timelapse
    t = Timer
    Cells(m + 5, n - 1).Value = totalPoints

    'Display the field in the coordinate system (display it in cylindrical coordinates)
        For i = Nline0x To Nlinex Step NLine
            For j = Nline0y To Nliney Step NLine2
                For k = Nline0z To Nlinez Step NLine3
                    On Error Resume Next
                    ActiveSheet.Cells(m + 8, n - 1).Value = i * Cos(WorksheetFunction.Radians(j)) + x_0
                    ActiveSheet.Cells(m + 8, n).Value = i * Sin(WorksheetFunction.Radians(j)) + y_0
                    ActiveSheet.Cells(m + 8, n + 1).Value = k + z_0
'                    DoEvents
                    
                    'Code to calculate the field in each point, according to formula of the cells m+9 (in the spreadsheet) and put in cells m+6 the resulting sum in eacha axis
                    'If the sum is not desidered, change the SumX, SumY and SumZ formulas below.
                     If flag = True And Cells(m + 10, n) > -1 Then
                            For sf = 1 To SubFieldN
                                If SubField(sf) <> m And VecOutFlag = True Then
                                'S = 1
                                 VecOutFlag = False
                                    Select Case Left(ActiveSheet.Cells(SubField(sf) + 4, n + 1).Value, 1)
                                        Case "s"
                                            Call ProcessSphericalCoordinates(SubField(sf), n, S, cod, xS, T_color, flag, SubField(), SubFieldN, VecOutFlag)
                                        Case "c"
                                            Call ProcessCylindricalCoordinates(SubField(sf), n, S, cod, xS, T_color, flag, SubField(), SubFieldN, VecOutFlag)
                                        Case "f"
                                            Call ProcessFibonacciCoordinates(SubField(sf), n, S, cod, xS, T_color, flag, SubField(), SubFieldN, VecOutFlag)
                                        Case "o"
                                            Call ProcessCartesianCoordinates(SubField(sf), n, S, cod, xS, T_color, flag, SubField(), SubFieldN, VecOutFlag)
                                    End Select
                                    VecOutFlag = True
                                End If
                            Next sf
                        Else
                            SumX = SumX + ActiveSheet.Cells(m + 9, n - 1).Value ' * 74 When values are very small (<10 -15), VBA is less accurate than Excel,
                            SumY = SumY + ActiveSheet.Cells(m + 9, n).Value ' * 74 so, try to multiplicate by 74
                            SumZ = SumZ + ActiveSheet.Cells(m + 9, n + 1).Value ' * 74
                        End If
                    
                        If VecOutFlag = True Then
                            Call VectorOutput(m, n, S, cod, Y_abs, Z_abs, xS, T_color) 'Put each vector in XYZ
                        End If
                    If Abs(Cells(m + 10, n).Value) > 3 And Abs(Cells(m + 11, n).Value) > 3 Then
                            Call DataOutput(m, n)
                    End If
                    S = S + 1 ' siguiente vector clonado
                Next k
            Next j
        Next i
        If WorksheetFunction.Or( _
            Left(ActiveSheet.Cells(m + 6, n - 1).FormulaR1C1, 1) <> "=", _
            Left(ActiveSheet.Cells(m + 6, n).FormulaR1C1, 1) <> "=", _
            Left(ActiveSheet.Cells(m + 6, n + 1).FormulaR1C1, 1) <> "=") Then
                ActiveSheet.Cells(m + 6, n - 1).Value = SumX
                ActiveSheet.Cells(m + 6, n).Value = SumY
                ActiveSheet.Cells(m + 6, n + 1).Value = SumZ
        End If
        
End Sub

Private Sub ProcessFibonacciCoordinates( _
    ByVal m As Integer, ByVal n As Integer, _
    ByRef S As Long, ByVal cod As Integer, _
    ByVal xS As Double, ByVal T_color As Double, _
    ByRef flag As Boolean, ByRef SubField() As Integer, _
    ByRef SubFieldN As Integer, ByRef VecOutFlag As Boolean)

'Segment ProcessFibonacciCoordinates -01. Define variables
    Dim NLine As Double, NLine2 As Double, NLine3 As Double
    Dim Nline0x As Double, Nline0y As Double, Nline0z As Double
    Dim Nlinex As Double, Nliney As Double, Nlinez As Double
    Dim x_0 As Double, y_0 As Double, z_0 As Double
    Dim tfactor As Double, t As Single, Bulk As Double
    Dim msg As String, Response As VbMsgBoxResult
    Dim SumX As Double, SumY As Double, SumZ As Double
    SumX = 0
    SumY = 0
    SumZ = 0

    On Error Resume Next
    ' Variables específicas para Fibonacci
    Dim goldenRatio As Double, radius As Double
    Dim pointIndex As Integer
    Dim theta As Double, phi As Double
    
    ' Configuración Fibonacci
    goldenRatio = (1 + Sqr(5)) / 2
    pointIndex = 0

    ' Extract parameters
    Call ExtractParameters("f", m, n, NLine, NLine2, NLine3, _
                                  Nline0x, Nlinex, Nline0y, Nliney, Nline0z, Nlinez, _
                                  tfactor, x_0, y_0, z_0, xS)

'Segment ProcessFibonacciCoordinates -02. Calculate aprox the number of vectors (points) that will be placed in the spreadsheet
    Dim totalPoints As Integer
    totalPoints = 0
    If NLine = 0 Then NLine = 1
    If NLine2 = 0 Then NLine2 = 1
    If NLine3 = 0 Then NLine3 = 1
    totalPoints = CInt(((Nlinex - Nline0x) / NLine + 1) * _
                  ((Nliney - Nline0y) / NLine2 + 1) * _
                  ((Nlinez - Nline0z) / NLine3 + 1))

     ' Alert if the number of vectors is large
     msg = totalPoints & " points will be generated." & vbCrLf & _
      "Estimated time: " & Round((totalPoints * tfactor + 15) / 60, 1) & " minutes. Proceed?"

    If Round((totalPoints * tfactor) / 60, 1) > 0.5 Then
        Response = MsgBox(msg, vbYesNo, "Confirmation")
        If Response = vbNo Then Exit Sub
    End If

'Segment ProcessFibonacciCoordinates -03. Process the spreadsheet range of the field
    ' Start timelapse
    t = Timer
    Cells(m + 5, n - 1).Value = totalPoints
    
    'Process coordinates
    For pointIndex = 1 To totalPoints
        ' Calculate angles using Fibonacci distribution
        On Error Resume Next

        theta = Application.WorksheetFunction.Acos(1 - 2 * pointIndex / totalPoints)
        phi = 2 * Application.WorksheetFunction.Pi() * (pointIndex / goldenRatio)
        radius = Nline0x + (Nlinex - Nline0x) * (pointIndex / totalPoints)
        
        ActiveSheet.Cells(m + 8, n - 1).Value = radius * Sin(theta) * Cos(phi) + x_0
        ActiveSheet.Cells(m + 8, n).Value = radius * Sin(theta) * Sin(phi) + y_0
        ActiveSheet.Cells(m + 8, n + 1).Value = radius * Cos(theta) + z_0
        On Error Resume Next
'        DoEvents

                'Code to calculate the field in each point, according to formula of the cells m+9 (in the spreadsheet) and put in cells m+6 the resulting sum in eacha axis
                'If the sum is not desidered, change the SumX, SumY and SumZ formulas below.
                If flag = True And Cells(m + 10, n) > -1 Then
                    For sf = 1 To SubFieldN
                        If SubField(sf) <> m And VecOutFlag = True Then
                        'S = 1
                         VecOutFlag = False
                            Select Case Left(ActiveSheet.Cells(SubField(sf) + 4, n + 1).Value, 1)
                                Case "s"
                                    Call ProcessSphericalCoordinates(SubField(sf), n, S, cod, xS, T_color, flag, SubField(), SubFieldN, VecOutFlag)
                                Case "c"
                                    Call ProcessCylindricalCoordinates(SubField(sf), n, S, cod, xS, T_color, flag, SubField(), SubFieldN, VecOutFlag)
                                Case "f"
                                    Call ProcessFibonacciCoordinates(SubField(sf), n, S, cod, xS, T_color, flag, SubField(), SubFieldN, VecOutFlag)
                                Case "o"
                                    Call ProcessCartesianCoordinates(SubField(sf), n, S, cod, xS, T_color, flag, SubField(), SubFieldN, VecOutFlag)
                            End Select
                            On Error Resume Next
                            VecOutFlag = True
                        End If
                    Next sf
'                    flag = False
                Else
                    SumX = SumX + ActiveSheet.Cells(m + 9, n - 1).Value ' * 74 When values are very small (<10 -15), VBA is less accurate than Excel,
                    SumY = SumY + ActiveSheet.Cells(m + 9, n).Value ' * 74 so, try to multiplicate by 74
                    SumZ = SumZ + ActiveSheet.Cells(m + 9, n + 1).Value ' * 74
                End If
                
                If VecOutFlag = True Then
                    Call VectorOutput(m, n, S, cod, Y_abs, Z_abs, xS, T_color) 'Put each vector in XYZ
               End If
                If Abs(Cells(m + 10, n).Value) > 3 And Abs(Cells(m + 11, n).Value) > 3 Then
                        Call DataOutput(m, n)
                End If
                S = S + 1 ' next vector
    Next pointIndex
    If WorksheetFunction.Or( _
            Left(ActiveSheet.Cells(m + 6, n - 1).FormulaR1C1, 1) <> "=", _
            Left(ActiveSheet.Cells(m + 6, n).FormulaR1C1, 1) <> "=", _
            Left(ActiveSheet.Cells(m + 6, n + 1).FormulaR1C1, 1) <> "=") Then
                ActiveSheet.Cells(m + 6, n - 1).Value = SumX
                ActiveSheet.Cells(m + 6, n).Value = SumY
                ActiveSheet.Cells(m + 6, n + 1).Value = SumZ
    End If
End Sub

Private Sub ProcessCartesianCoordinates( _
    ByVal m As Integer, ByVal n As Integer, _
    ByRef S As Long, ByVal cod As Integer, _
    ByVal xS As Double, ByVal T_color As Double, _
    ByRef flag As Boolean, ByRef SubField() As Integer, _
    ByRef SubFieldN As Integer, ByRef VecOutFlag As Boolean)

'Segment ProcessCartesianCoordinates -01. Define variables
    Dim NLine As Double, NLine2 As Double, NLine3 As Double
    Dim x_0 As Double, y_0 As Double, z_0 As Double
    Dim Nline0x As Double, Nline0y As Double, Nline0z As Double
    Dim Nlinex As Double, Nliney As Double, Nlinez As Double
    Dim tfactor As Double, t As Single, Bulk As Double
    Dim msg As String, Response As VbMsgBoxResult
    Dim i As Double, j As Double, k As Double, sf As Integer
    Dim SumX As Double, SumY As Double, SumZ As Double
    SumX = 0
    SumY = 0
    SumZ = 0
    On Error Resume Next
    
     'Extract Parameters
    Call ExtractParameters("o", m, n, NLine, NLine2, NLine3, _
                                  Nline0x, Nlinex, Nline0y, Nliney, Nline0z, Nlinez, _
                                  tfactor, x_0, y_0, z_0, xS)

'Segment ProcessCartesianCoordinates -02. Calculate aprox the number of vectors (points) that will be placed in the spreadsheet
    Dim totalPoints As Integer
    totalPoints = 0
    If NLine = 0 Then NLine = 1
    If NLine2 = 0 Then NLine2 = 1
    If NLine3 = 0 Then NLine3 = 1
    totalPoints = CInt(((Nlinex - Nline0x) / NLine + 1) * _
                  ((Nliney - Nline0y) / NLine2 + 1) * _
                  ((Nlinez - Nline0z) / NLine3 + 1))

    ' Alert if the number of vectors is large
     msg = totalPoints & " points will be generated." & vbCrLf & _
      "Estimated time: " & Round((totalPoints * tfactor + 15) / 60, 1) & " minutes. Proceed?"

    If Round((totalPoints * tfactor) / 60, 1) > 0.5 Then
        Response = MsgBox(msg, vbYesNo, "Confirmation")
        If Response = vbNo Then Exit Sub
    End If

'Segment ProcessCartesianCoordinates -03. Process the spreadsheet range of the field
    ' Start timelapse
    t = Timer
    Cells(m + 5, n - 1).Value = totalPoints
    
        ''Display the field in the coordinate system (display it in Cartesian coordinates)
            For i = Nline0x To Nlinex Step NLine
                For j = Nline0y To Nliney Step NLine2
                    For k = Nline0z To Nlinez Step NLine3
                        On Error Resume Next
                        ActiveSheet.Cells(m + 8, n - 1).Value = i + x_0
                        ActiveSheet.Cells(m + 8, n).Value = j + y_0
                        ActiveSheet.Cells(m + 8, n + 1).Value = k + z_0
'                        DoEvents ' Uncomment to enable possibility to stop  when simulating (it takes much more time)

                        'Code to calculate the field in each point, according to formula of the cells m+9 (in the spreadsheet) and put in cells m+6 the resulting sum in eacha axis
                        'If the sum is not desidered, change the SumX, SumY and SumZ formulas below.
                         If flag = True And Cells(m + 10, n) > -1 Then

                            For sf = 1 To SubFieldN
                                If SubField(sf) <> m And VecOutFlag = True Then
                                 VecOutFlag = False
                                    Select Case Left(ActiveSheet.Cells(SubField(sf) + 4, n + 1).Value, 1)
                                        Case "s"
                                            Call ProcessSphericalCoordinates(SubField(sf), n, S, cod, xS, T_color, flag, SubField(), SubFieldN, VecOutFlag)
                                        Case "c"
                                            Call ProcessCylindricalCoordinates(SubField(sf), n, S, cod, xS, T_color, flag, SubField(), SubFieldN, VecOutFlag)
                                        Case "f"
                                            Call ProcessFibonacciCoordinates(SubField(sf), n, S, cod, xS, T_color, flag, SubField(), SubFieldN, VecOutFlag)
                                        Case "o"
                                            Call ProcessCartesianCoordinates(SubField(sf), n, S, cod, xS, T_color, flag, SubField(), SubFieldN, VecOutFlag)
                                    End Select
                                    VecOutFlag = True
                                End If
                            Next sf
                        Else
                            SumX = SumX + ActiveSheet.Cells(m + 9, n - 1).Value ' * 74 When values are very small (<10E -15), VBA is less accurate than Excel,
                            SumY = SumY + ActiveSheet.Cells(m + 9, n).Value ' * 74 so, in that case try to multiplicate by 74
                            SumZ = SumZ + ActiveSheet.Cells(m + 9, n + 1).Value ' * 74
                        End If
                        
                         If VecOutFlag = True Then
                            Call VectorOutput(m, n, S, cod, Y_abs, Z_abs, xS, T_color) 'Put each vector in XYZ
                        End If
                        If Abs(Cells(m + 10, n).Value) > 3 And Abs(Cells(m + 11, n).Value) > 3 Then
                                Call DataOutput(m, n)
                        End If
                        S = S + 1 ' next vector
                    Next k
                Next j
            Next i
            If WorksheetFunction.Or( _
            Left(ActiveSheet.Cells(m + 6, n - 1).FormulaR1C1, 1) <> "=", _
            Left(ActiveSheet.Cells(m + 6, n).FormulaR1C1, 1) <> "=", _
            Left(ActiveSheet.Cells(m + 6, n + 1).FormulaR1C1, 1) <> "=") Then
                ActiveSheet.Cells(m + 6, n - 1).Value = SumX
                ActiveSheet.Cells(m + 6, n).Value = SumY
                ActiveSheet.Cells(m + 6, n + 1).Value = SumZ
            End If
End Sub

Sub Rotate()
    '© 2022 A Becerra. ScienSolar.com
    
    'Procedure to update the spreadsheet
    Application.ScreenUpdating = False
    Dim t As Single ' para medir el tiempo 1/100 s quitar el comentario
    t = Timer
    Dim fila As Range
    Dim m As Integer
    Dim n As Integer
    
    Set fila = Cells.Find(what:="INICIO")
    m = fila.Offset(1, 0).Row
    n = fila.Offset(1, 1).Column
    Set fila = Nothing

    Call XYZ(m, n)
    Call Field(m, n)
    Application.ScreenUpdating = True
    Cells(m + 2, n).Value = "t = " & Timer - t & " s."  ' muestra el tiempo que dura el codigo en ejecutarse. Quitar el comentario
End Sub

Sub CreateLabel(ByVal L, t, W, H As Single, T_color As Double, name, label As Variant)
'Procedure to create labels of the vectors
'© 2022 A Becerra. ScienSolar.com

    On Error Resume Next
    If Left(label, 3) = "(Eq" Then
         Sheets("3DModels").Shapes(label).Copy
         ActiveSheet.Paste
         With ActiveSheet.Shapes(label)
            .Left = L
            .Top = t
            .TextFrame2.TextRange.Characters.Font.Fill.ForeColor.RGB = T_color
        End With
        ActiveSheet.Buttons("AutoSc").Select
    Else
        ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, L, t, 100, H).name = "Cuadro" & name
        With ActiveSheet.Shapes("Cuadro" & name)
                With .TextFrame2.TextRange.Characters
                    .text = label
                    With .Font.Fill
                        .ForeColor.RGB = T_color
                        .Transparency = W
                        .Solid
                    End With
                End With
         End With
        ActiveSheet.Shapes("Cuadro" & name).Fill.Visible = msoFalse
        ActiveSheet.Shapes("Cuadro" & name).line.Visible = msoFalse
        ActiveSheet.Shapes("Cuadro" & name).TextFrame2.AutoSize = msoAutoSizeShapeToFitText
        ActiveSheet.Shapes("Cuadro" & name).TextFrame2.WordWrap = msoTrue  'modif may 2023
    End If
End Sub
Sub InitVector(ByVal m, n As Integer)
' Procedure to add vectors to the spreadsheet. Specifically adding 9 rows to the first 3 columns to set up a vector
    '© 2022 A Becerra. ScienSolar.com
    Application.ScreenUpdating = False
    
'Segment InitVector-02. Define variables
    Dim Vname As String
    Dim lista As Range
    Dim Vcolor As Variant
    Dim VecType As Integer
    Dim m1 As Integer
    Dim n1 As Integer
    Dim flag As Boolean
    Dim FormatName As String
    Dim Lang As String
    
    m1 = m
    n1 = n
    Vname = Cells(m + 1, n + 1).Value   ' Name of the vector
    Vcolor = Cells(m + 1, n + 1).Interior.Color   ' Color of the vector
    If Application.Caller = "NewVector" Then
        VecType = 1  ' New vector button
    Else
        VecType = Cells(m + 1, n - 1).Value ' Vectors from project list
    End If
    If VecType < 2 Then
        Vname = InputBox("Enter a letter or short name for the vector:", "Vector", Vname)
        If Vname = "" Then
            Vname = Cells(m + 1, n + 1).Value
        End If
        Cells(m + 2, n + 12).Value = Cells(m + 2, n + 12).Value + 1 ' register the added vector
    End If
    Cells(m + 2, n + 9).Select
    Selection.FormulaR1C1 = "A" & "." & " " & "B" & "e" _
    & "c" & "e" & "r" & "r" & "a" & "  " & "B" & "."
    With Selection.Font
        .Color = Selection.Interior.Color
    End With
    
'Segment InitVector-02a. Set language of the control panel
    Set lista = Sheets("CONFIG").Cells.Find(what:="LENGUAJE")
    m2 = lista.Row
    n2 = lista.Offset(0, -1).Column
    Set lista = Nothing
    Lang = WorksheetFunction.VLookup(ActiveSheet.Cells(m - 1, n + 18).Value, Sheets("CONFIG").Range(Cells(m2, n2).Address(0, 0) & ":" & Cells(m2 + 14, n2 + 2).Address(0, 0)), 3, False)
     
'Segment InitVector-01. Count the current number of vectors in the spreadsheet
    i = 0
    flag = False
    Do While Cells(m + 4 + 9 * i, n - 1).Value <> ""
      If Cells(m + 4 + 9 * i, n).Value = "186" And VecType = 15 Then
        flag = True
      End If
        i = i + 1
    Loop
     
'Segment InitVector-03. Define vector parameters
    m = m + i * 9
    Cells(m + 1, n).Select
    PatronW = ActiveSheet.Cells(m + 3, n - 1).Width
    PatronH = ActiveSheet.Cells(m + 3, n - 1).Height
    PatronT = ActiveSheet.Cells(m + 3, n - 1).Top
     If flag = True Then GoTo NoVector

'Segment InitVector-03a. Restrict values for data table cells
    Range(Cells(m + 10, n), Cells(m + 11, n)).Validation.Delete
    Range(Cells(m + 10, n), Cells(m + 11, n)).Validation.Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _
        Operator:=xlGreaterEqual, Formula1:="-1"
    Range(Cells(m + 10, n), Cells(m + 11, n)).Validation.InputTitle = "DATA OUTPUT"
    Range(Cells(m + 10, n), Cells(m + 11, n)).Validation.InputMessage = "Enter the row and column number to generate " & " coordinates data during the simulation." & "The number ""0"" indicates that no data will be generated. Make sure that  " & "the cells do not intersect already occupied cells.  "
    Range(Cells(m + 10, n), Cells(m + 11, n)).Validation.ErrorMessage = "For rows or columns, you can only enter a positive integer."
    
'Segment InitVector-04. Set format
    ActiveSheet.Cells(m + 3, n).Select
    With Selection
        .Value = Vname
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With

'Segment InitVector-05. Put the first button in cell A6
    ActiveSheet.Buttons.Add(PatronW * (n - 2), PatronT, PatronW / 3, PatronH).Select
    Selection.name = "Conf_" & Cells(m + 3, n - 1).Row
    Selection.OnAction = "VectorForm"
    Selection.Characters.text = ChrW(9967)
    With Selection.Characters(Start:=1, Length:=3).Font
        .name = "Calibri"
        .FontStyle = "Normal"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
    End With
    
'Segment InitVector-06. Put the second button in cell A6
    ActiveSheet.Buttons.Add(PatronW * (n - 4 / 3), PatronT, PatronW / 3, PatronH).Select
    Selection.name = Cells(m + 3, n - 1).Row
    Selection.OnAction = "ShowHideVecConf"
    Selection.Characters.text = ChrW(9650)
    With Selection.Characters(Start:=1, Length:=3).Font
        .name = "Calibri"
        .FontStyle = "Normal"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
    End With
    ActiveSheet.Cells(m + 3, n - 1).Select
    
'Segment InitVector-06a. Set parameters by default
    ActiveSheet.Cells(m + 3, n - 1).Value = i + 1 ' numero del vector
    ActiveSheet.Cells(m + 4, n - 1).Value = "1" ' menu desplegado
    ActiveSheet.Cells(m + 4, n).Value = "183" ' tipo de vector (forma)
    ActiveSheet.Cells(m + 5, n).Value = "1" ' tipo de linea
    ActiveSheet.Cells(m + 5, n).NumberFormat = """line:   "" 0.0 "
    ActiveSheet.Cells(m + 5, n + 1).Value = "0.3" ' transparencia
    ActiveSheet.Cells(m + 5, n + 1).NumberFormat = """transp.:   "" 0.0 "
    ActiveSheet.Cells(m + 5, n - 1).Value = 1 ' memoria de la cantidad de vectores campo
    ActiveSheet.Cells(m + 7, n - 1).Value = "0" 'componente x inicial
    ActiveSheet.Cells(m + 7, n).Value = "0" 'componente y inicial
    ActiveSheet.Cells(m + 7, n + 1).Value = "0" 'componente z inicial
    ActiveSheet.Cells(m + 9, n - 1).Value = "2" ' valor x del vector
    ActiveSheet.Cells(m + 9, n).Value = "2" ' valor y del vector
    ActiveSheet.Cells(m + 9, n + 1).Value = 2 * (i + 1) ' valor z del vector"
    ActiveSheet.Cells(m + 10, n - 1).Value = 1 ' cola del vector
    ActiveSheet.Cells(m + 10, n - 1).NumberFormat = """tail:   "" 0 "
    ActiveSheet.Cells(m + 10, n).Value = "0"
    ActiveSheet.Cells(m + 10, n).NumberFormat = """Dat row:   "" 0 "
    ActiveSheet.Cells(m + 10, n + 1).Value = "1"
    ActiveSheet.Cells(m + 10, n + 1).NumberFormat = """history:   "" 0 "
    ActiveSheet.Cells(m + 11, n - 1).Value = 3 ' cabeza del vector
    ActiveSheet.Cells(m + 11, n - 1).NumberFormat = """head:   "" 0 "
    ActiveSheet.Cells(m + 11, n).Value = "0" ' grosor
    ActiveSheet.Cells(m + 11, n).NumberFormat = """Dat col:   "" 0 "
    ActiveSheet.Cells(m + 11, n + 1).Value = 1 ' grosor del vector
    ActiveSheet.Cells(m + 11, n + 1).NumberFormat = """thickness:   "" 0 "  ' grosor del vector
    ActiveSheet.Cells(m + 7, n - 1).FormulaR1C1 = "=R[-7]C+R[-9]C" 'posiciones iniciales del vector = final del vector anterior
    ActiveSheet.Cells(m + 7, n).FormulaR1C1 = "=R[-7]C+R[-9]C"
    ActiveSheet.Cells(m + 7, n + 1).FormulaR1C1 = "=R[-7]C+R[-9]C"
    
'Segment InitVector-07. Control panel format
    Range(Cells(m + 3, n - 1), Cells(m + 11, n + 1)).Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0.249977111117893
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0.249977111117893
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0.249977111117893
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0.249977111117893
        .Weight = xlThick
    End With
        With Selection
        .HorizontalAlignment = xlCenter
    End With
    Cells(m + 3, n + 1).Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0.249977111117893
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0.249977111117893
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0.249977111117893
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0.249977111117893
        .Weight = xlThick
    End With
    Cells(m + 4, n + 1).Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlDashDot
        .ThemeColor = 2
        .TintAndShade = 0.249977111117893
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDashDot
        .ThemeColor = 2
        .TintAndShade = 0.249977111117893
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDashDot
        .ThemeColor = 2
        .TintAndShade = 0.249977111117893
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlDashDot
        .ThemeColor = 2
        .TintAndShade = 0.249977111117893
        .Weight = xlThin
    End With
    Range(Cells(m + 4, n - 1), Cells(m + 11, n + 1)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
    Range(Cells(m + 3, n - 1), Cells(m + 3, n)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
    Application.Union(Range(Cells(m + 7, n - 1), Cells(m + 7, n + 1)), Range(Cells(m + 9, n - 1), Cells(m + 9, n + 1))).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Cells(m + 3, n + 1).Select ' Color for each vector (different color).
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0.5
        .Color = RGB(Int((255 * Rnd) + 1), Int((255 * Rnd) + 1), Int((1 * Rnd) + 255))
        .PatternTintAndShade = 0
    End With
    Cells(m1 + 1, n1 + 1).Value = "A" & Cells(m + 3, n - 1).Value + 1
NoVector:

'Segment InitVector-08.Download projects from the project list
    Lang = "_" & Lang
    If VecType = 2 Then Lang = ""
    If VecType = 15 Then Lang = ""
    
    If VecType > 1 Then
        Dim strMacro As String
        strMacro = "Project_" & VecType & Lang
        Application.Run strMacro, VecType, m, n, m1, n1
    End If

    Application.ScreenUpdating = True
End Sub
    Sub AddNewVector()
    '© 2022 A Becerra. ScienSolar.com
    Dim fila As Range
    Dim m As Integer
    Dim n As Integer
    Dim A As Integer
    
    Set fila = ActiveSheet.Cells.Find(what:="INICIO")
    m = fila.Offset(1, 0).Row
    n = fila.Offset(1, 1).Column
    Set fila = Nothing

    Call InitVector(m, n)
    If Application.Caller = "AddVector1" Then
        Call RenameSheet
    End If
    End Sub
Sub VectorOutput(m, n, S, cod As Integer, Y_abs, Z_abs, xS As Double, T_color As Double)
'© 2022 A Becerra. ScienSolar.com
'Procedure to Display a single vector in XYZ

'Segment VectorOutput-01. Vector parameters variables
    Dim T_top
    Dim T_left
    Dim T_name
    Dim T_label
    Dim L_width As Double
    Dim L_height As Double
    Dim Lo_width As Double
    Dim Lo_height As Double
    Dim HeightColor As Variant
    Dim sh As Object
    Dim Module As Double
    On Error Resume Next
    T_name = ActiveSheet.Cells(m + 3, n).Value & ActiveSheet.Cells(m + 3, n - 1).Value
    T_label = ActiveSheet.Cells(m + 3, n).Value
    Lox = ActiveSheet.Cells(m + 7, n - 1).Value * xS  'Position of the vector in X. Obs. :it is not the component of L (axes) but of an arbitrary vector
    Loy = ActiveSheet.Cells(m + 7, n).Value * xS 'Position of the vector in Y. Obs. :it is not the component of L (axes) but of an arbitrary vector
    Loz = ActiveSheet.Cells(m + 7, n + 1).Value * xS 'Position of the vector in X. Obs. :it is not the component of L (axes) but of an arbitrary vector
    Lx = ActiveSheet.Cells(m + 9, n - 1).Value * xS 'Compponent in X of the vector
    Ly = ActiveSheet.Cells(m + 9, n).Value * xS 'Compponent in Y of the vector
    Lz = ActiveSheet.Cells(m + 9, n + 1).Value * xS ''Compponent in Z of the vector
    Module = Sqr((Lx / xS) ^ 2 + (Ly / xS) ^ 2 + (Lz / xS) ^ 2) ' Module of the vector
    
' Segment VectorOutput-01a. Filter module range of values. Get values for equipotential surfaces according to value entered by user.

    If ActiveSheet.Cells(m + 4, n + 1).Value <> "" Then
        
        'Output Min and Max values of the field
        If Range("O6").Value = "" Then
            Range("O6").Value = "Min. val.:"
            Range("Q6").Value = "Max. val.:"
            Range("P6").Value = 1E+50
            Range("R6").Value = 0
        End If
        If Module < Range("P6").Value Then Range("P6").Value = Module
        If Module > Range("R6").Value Then Range("R6").Value = Module
        
        ' Filter equpotencial surfaces:
        Dim LoFMR, UpFMR, Atemp, Btemp, Ctem, LayerThickness As Double
        Dim FieldLayers As Integer
        Atemp = InStr(ActiveSheet.Cells(m + 4, n + 1).Value, "FieldLayers[") + 12
        If Atemp = 12 Then ' This is for old configuratios of the cell C7
        Else
            Btemp = InStr(Atemp, ActiveSheet.Cells(m + 4, n + 1).Value, "]", 1)
            Ctemp = Btemp - Atemp
            FieldLayers = Mid(ActiveSheet.Cells(m + 4, n + 1).Value, Atemp, Ctemp)
            If FieldLayers > 0 And IsNumeric(FieldLayers) Then
            
                'Identify lower margin of the Module:
                Atemp = InStr(ActiveSheet.Cells(m + 4, n + 1).Value, "FieldLayersRange=") + 18
                Btemp = InStr(Atemp, ActiveSheet.Cells(m + 4, n + 1).Value, ";", 1)
                Ctemp = Btemp - Atemp
                LoFMR = CDbl(Mid(ActiveSheet.Cells(m + 4, n + 1).Value, Atemp, Ctemp))
                
                'Identify upper margin of the Module:
                Atemp = InStr(ActiveSheet.Cells(m + 4, n + 1).Value, "FieldLayersRange=") + 19 + Ctemp
                Btemp = InStr(Atemp + 1, ActiveSheet.Cells(m + 4, n + 1).Value, "]", 1)
                Ctemp = Btemp - Atemp
                UpFMR = CDbl(Mid(ActiveSheet.Cells(m + 4, n + 1).Value, Atemp, Ctemp))
                
                 'Identify layer thickness:
                Atemp = InStr(ActiveSheet.Cells(m + 4, n + 1).Value, "LayerThickness=[") + 16
                Btemp = InStr(Atemp + 1, ActiveSheet.Cells(m + 4, n + 1).Value, "]", 1)
                Ctemp = Btemp - Atemp
                LayerThickness = CDbl(Mid(ActiveSheet.Cells(m + 4, n + 1).Value, Atemp, Ctemp))
                
                'Filter module values in the given range:
                If Module < LoFMR Or Module > UpFMR Then
                    S = S - 1
                    Exit Sub
                Else
                
                    ' Function to deal with small quantities (VBA is not good with very small quantities)
                    Dim Numerador As Double, Denominador As Double
                    Dim Factor As Double
                    Dim MinValor As Double
                    
                    ' Threshold for considering a number small
                    Const UMBRAL As Double = 1E-05
                    
                    ' Identify the smallest value among Module, LoFMR and UpFMR
                    MinValor = Application.WorksheetFunction.Min(Abs(Module), Abs(LoFMR), Abs(UpFMR))
                    
                    ' Calculate the scale factor only if the values are smaller than UMBRAL
                    If MinValor < UMBRAL And MinValor <> 0 Then
                        Factor = 10 ^ (Int(-Log(MinValor) / Log(10#)) + 1) ' Ej: Para 1E-11 ? Factor = 1E+12
                    Else
                        Factor = 1  ' Do not scale if the values are not small
                    End If
                    
                    ' Apply the factor and calculate the module
                    Numerador = Abs((Module * Factor) - (LoFMR * Factor))
                    Denominador = Abs(((UpFMR * Factor) - (LoFMR * Factor)) / FieldLayers)
                    
                     'Avoid division by zero
                    If Denominador = 0 Then
                        S = S - 1
                        Exit Sub
                    Else
                    
                    'Filter Module values in the given layers, if Numerador is a multiple of Denominador
                        If FieldLayers = 1 Then LayerThickness = UpFMR - LoFMR
                        If Abs(Numerador - Denominador * Int(Numerador / Denominador)) > LayerThickness Then
                            S = S - 1
                            Exit Sub
                        End If
                    End If
                    
                End If
            End If
        End If
    End If
    
'Segment VectorOutput-02. If the size of the vector exceeds the size of the axes, then regulate its length with the help of a function and  parameters entered by the user (>15)
    If Cells(m + 5, n).Value > 15 Then
        Dim L_ref As Single ' Max lenght of the vector(first parameter)
        Dim L_tau As Single ' How the lenght of the vectors changes.
        L_ref = Left(Cells(m + 5, n).Value, InStr(1, Cells(m + 5, n).Value, "*", 0) - 1) - 14
        L_tau = L_ref * Mid(Cells(m + 5, n).Value, InStr(1, Cells(m + 5, n).Value, "*", 0) + 1)
ReScale:
        Lx = L_ref * (1 - 1 / Exp(Abs(Lx / L_tau))) * Lx / Module / xS ' updated 07-2024, added / xS in order to big scales to work properly.
        Ly = L_ref * (1 - 1 / Exp(Abs(Ly / L_tau))) * Ly / Module / xS
        Lz = L_ref * (1 - 1 / Exp(Abs(Lz / L_tau))) * Lz / Module / xS
        ActiveSheet.Range("K6").Value = "Vectors visually modified (magnitude unchanged). Adjust scale in  " & Cells(m + 5, n).Address(0, 0)
        If Application.WorksheetFunction.Or(Abs(Lx) > Range("E6").Value, Abs(Ly) > Range("E6").Value, Abs(Lz) > Range("E6").Value) Then
            Lx = 0.8 * Lx
            Ly = 0.8 * Ly
            Lz = 0.8 * Lz
            GoTo ReScale
        End If
    End If
    L_width = Cos(A) * (Lx * Sin(c) + Ly * Cos(c)) - Sin(A) * (-Sin(B) * (Lx * Cos(c) - Ly * Sin(c)) + Lz * Cos(B))
    L_height = Sin(A) * (Lx * Sin(c) + Ly * Cos(c)) + Cos(A) * (-Sin(B) * (Lx * Cos(c) - Ly * Sin(c)) + Lz * Cos(B))
    Lo_width = Cos(A) * (Lox * Sin(c) + Loy * Cos(c)) - Sin(A) * (-Sin(B) * (Lox * Cos(c) - Loy * Sin(c)) + Loz * Cos(B))
    Lo_height = Sin(A) * (Lox * Sin(c) + Loy * Cos(c)) + Cos(A) * (-Sin(B) * (Lox * Cos(c) - Loy * Sin(c)) + Loz * Cos(B))
        
'Segment VectorOutput-03. Data storage to graph trajectory.
    If Cells(m + 3, n - 1).Value = Sheets("CONFIG").Range("V6").Value Then  ' Verify that the current is the vector to be graphed
        Sheets("CONFIG").Range("V6").Offset(1, -1).Value = "DATOS DE LA FORMA LIBRE - puntos horizontales y verticales"
        Z = 1
        Do While Sheets("CONFIG").Cells(6 + Z, 21).Value <> ""
            Z = Z + 1
        Loop
        Sheets("CONFIG").Cells(6 + Z, 21).Value = Lo_width + L_width 'Cell where the y coordinate of each point of the free form is stored
        Sheets("CONFIG").Cells(6 + Z, 22).Value = -Lo_height - L_height 'Cell where the z coordinate of each point is stored
        
       'Stops plotting after set value of steps
        If Z - 2 > Sheets("CONFIG").Range("T5") Then
            Sheets("CONFIG").Columns("U:V").ClearContents
            ActiveSheet.Range(ActiveSheet.Buttons("ResetGraph").TopLeftCell.Offset(1, 1).Address).Value = 2 'it does not erase the graph already drawn
        End If
    End If
        
'Segment VectorOutput-04. Selection of the shape according to cod.
    If cod < 0 Then
        cod = -cod
        L_width = Cells(m + 9, n) * xS
        L_height = Cells(m + 9, n + 1) * xS
        Lo_width = Cells(m + 7, n) * xS
        Lo_height = Cells(m + 7, n + 1) * xS
    End If
        
'Segment VectorOutput-05. Graphic case. Draw a freeform with the points collected in Segment VectorOutput-03.
    If cod = 186 Then
        With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, Y_abs + Sheets("CONFIG").Cells(8, 21).Value, Z_abs + Sheets("CONFIG").Cells(8, 22).Value)
            i = 1
            Do While Sheets("CONFIG").Cells(7 + i, 21) <> ""
                .AddNodes msoSegmentCurve, msoEditingAuto, Y_abs + Sheets("CONFIG").Cells(7 + i, 21).Value, Z_abs + Sheets("CONFIG").Cells(7 + i, 22).Value
                i = i + 1
            Loop
            .ConvertToShape.name = "campo0" ' crea una forma de tipo 5
        End With
    Else ' if not 186
        
'Segment VectorOutput-06 Integrate a 3D object. To integrate a 3D object enter code 200.
        If cod = 200 Or cod = 201 Then 'Number for 3D objects. The name of the 3D object must be in the vector name cell and the object must be in the 3D Models spreadsheet.
            Dim name3D As String
            name3D = Cells(m + 3, n).Value
            If Cells(m + 3, n + 1) <> "" And Cells(m + 3, n + 1).Value <> name3D Then
                ActiveSheet.Shapes(Cells(m + 3, n + 1).Value).Delete
            End If
            CheckExists (name3D)
            If CheckExists(name3D) = False Then
                Sheets("3DModels").Shapes(name3D).Copy
                ActiveSheet.Paste
                Cells(m + 3, n + 1).Select
                Selection.Value = name3D
            Else
                If S > 1 Then
                    ActiveSheet.Shapes(Cells(m + 3, n).Value).Copy
                    ActiveSheet.Paste
                    Selection.name = "campo" & Cells(m + 3, n - 1).Value & "_" & S
                    name3D = "campo" & Cells(m + 3, n - 1).Value & "_" & S
                End If
            End If
            With ActiveSheet.Shapes(name3D)
                If .Type = 30 Or .Type = 13 Then ' 30 for Mac 13 for Win. Only for 3D objects
                    If Left(Application.Version, 2) < 16 Then ' Warning about old Excel vrsions
                        Range("N10").Value = "(Your version of Excel may not support 3D models. Please, update to 2019 or later!!)"
                    End If
                    .Width = -1 ' To fix error
                    If Cells(m + 5, n).Value > 0 Then
                        .Width = Cells(m + 5, n) * xS
                        .Height = Cells(m + 5, n) * xS
                        Cells(m + 5, n + 1).Value = Cells(m + 5, n).Value
                    End If
                Else ' Other objects
                    Cells(m + 3, n + 1).Value = ""
                    If .Type = 17 Then ' To color formulas.
                        .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = Cells(m + 3, n + 1).Interior.Color
                    End If
                End If
                If cod = 201 Then 'Freeze size in text area
                    .Left = Y_abs + ActiveSheet.Cells(m + 7, n).Value
                    .Top = Z_abs - ActiveSheet.Cells(m + 7, n + 1).Value
                Else
                    .Left = Y_abs + Lo_width
                    .Top = Z_abs - Lo_height
                    .Model3D.RotationX = ActiveSheet.Range("G5").Value + ActiveSheet.Cells(m + 6, n - 1).Value
                    .Model3D.RotationY = -ActiveSheet.Range("G6").Value + ActiveSheet.Cells(m + 6, n).Value
                    .Model3D.RotationZ = -ActiveSheet.Range("G4").Value + ActiveSheet.Cells(m + 6, n + 1).Value
                End If
            End With
            'If s = 1 Then
                'Selection.name = ActiveSheet.Cells(m + 3, n) 'Comment to get story
            'End If
            ActiveSheet.Cells(m + 5, n).Value = 0
        Else ' neither 200 nor 201
            Set sh = ActiveSheet.Shapes.AddShape(cod, Y_abs, Z_abs, 20, 40) 'otras formas
            sh.name = "campo0"
        End If
    End If ' end if 186
        
'Segment VectorOutput-07. Vector appearance.
    HeightColor = Cells(m + 3, n + 1).Interior.Color
    If ActiveSheet.Cells(m + 4, n + 1).Value <> "" Then
        Atemp = InStr(ActiveSheet.Cells(m + 4, n + 1).Value, "color=") + 7
        Btemp = InStr(Atemp, ActiveSheet.Cells(m + 4, n + 1).Value, "]", 1)
        Ctemp = Btemp - Atemp
        
        Lmax = Mid(ActiveSheet.Cells(m + 4, n + 1).Value, Atemp, Ctemp)
        If Lmax = "0" Then
            HeightColor = Cells(m + 3, n + 1).Interior.Color
        Else
            ' Normalize the modulus between 0 and 1
            Dim normalizedValue As Double
            normalizedValue = Module / Lmax
            
              ' Get control cell value (0-100)
            Dim sliderValue As Double
            sliderValue = Cells(m + 3, n + 1).Value / 100 ' Normalize to 0-1
            
            ' Configure dynamic checkpoints
            Dim colorStops() As Variant
            colorStops = GetDynamicColorStops(sliderValue)

            ' Get color gradient
            HeightColor = GetGradientColor(normalizedValue, colorStops)
        End If
    End If
    
'Segment VectorOutput-08. If it is not a vector but a point. set dimensions = 1.
    If cod = 146 Or cod = 9 Then ' updated 04.2024
        L_width = 1
        L_height = 1
    End If
        
    'Vector properties
    On Error Resume Next ' no todas las propiedades aplican para todas las formas
    With ActiveSheet.Shapes.Range(Array("campo0")) ' apariencia del vector
        .line.BeginArrowheadStyle = Cells(m + 10, n - 1).Value
        .line.EndArrowheadStyle = Cells(m + 11, n - 1).Value
        .line.ForeColor.RGB = HeightColor
        .line.Transparency = Cells(m + 5, n + 1).Value
        .line.DashStyle = Cells(m + 5, n).Value
        .line.Weight = Cells(m + 11, n + 1).Value
        
        'Complementary properties of other forms.
         If cod < 183 Then
            .TextFrame2.TextRange.Characters.text = Cells(m + 6, n - 1).Value
            .Fill.ForeColor.RGB = HeightColor ' color de relleno
            '.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = Cells(m + 3, n + 1).Font.Color. Uncomment to color frame
            .TextFrame2.TextRange.Font.Size = Cells(m + 3, n + 1).Value
            .shapeRange.TextFrame2.WordWrap = msoTrue
            .shapeRange.TextFrame2.AutoSize = msoAutoSizeShapeToFitText
            .Fill.Transparency = Cells(m + 5, n + 1).Value
            ' The position of the arrow head for shapes 109-114 is indicated in row =Cells(m + 6, n) and column =Cells(m + 6, n + 1), text =Cells(m + 6, n - 1)
            .Adjustments.item(4) = -(Y_abs - (Cells(m + 6, n + 1).Value - 0.5) * 65 + Cells(m + 7, n).Value * xS) / (Cells(m + 9, n).Value * xS) ' arrow position, if applicable
            .Adjustments.item(3) = 1 - (Z_abs - Cells(m + 6, n).Value * 15 - Cells(m + 7, n + 1).Value * xS) / (Cells(m + 9, n + 1).Value * xS) 'arrow position, if applicable
         End If
    End With
        
'Segment VectorOutput-09. Rename the vector and set position of the shape.
    With ActiveSheet.Shapes("campo0")
            .name = "campo" & Cells(m + 3, n - 1).Value & "_" & S
            If cod > 183 Then  ' Free form case
                'do nothing for a free form (graphic)
            Else
                .Width = Abs(L_width)
                .Height = Abs(L_height)
                .Left = Y_abs + Lo_width
                .Top = Z_abs - Lo_height - L_height
                If L_width < "0" Then
                    .Left = .Left + L_width
                    .Flip msoFlipHorizontal
                    T_left = .Left - L_width / 2
                Else
                    T_left = .Left + L_width / 2
                End If
                If L_height < "0" Then
                    .Top = .Top + L_height
                    .Flip msoFlipVertical
                    T_top = .Top - L_height / 2
                Else
                    T_top = .Top + L_height / 2
                End If
            End If ' End of cod > 183
    End With
    
'Segment VectorOutput-10. Create the vector label.
    If T_label <> "" Then
        If S = 1 And cod <> 200 Then
            Call CreateLabel(T_left, T_top, Cells(m + 5, n + 1).Value, 20, T_color, T_name, T_label)
        End If
    End If
    Set sh = Nothing
End Sub
Sub CheckIfProjectExists()

'Segment CheckIfProjectExists-01. Define variables
    Dim MyModule As Object
    Dim MyModuleName As String
    Dim MySubReference As String
    Dim MySub As String
    Dim MyLine As Long
    Dim MyLine1 As Long
    Dim ProjLongName As String
    Dim VBAComp As Variant
    Dim ProjLang As String
    Dim i As Integer
    Dim ProjInList As String
    Dim flag As Boolean
    Dim LangCode As Integer
    If Application.Caller = "RefreshList" Then
        LangCode = Worksheets("CONFIG").Cells(45, 1).Value
    Else
        LangCode = Worksheets("CONFIG").Cells(2, 17).Value
    End If
    ProjLang = WorksheetFunction.VLookup(LangCode, Worksheets("CONFIG").Range("P3:R14"), 3)
    MySubReference = Range("A4").Value
    flag = False
    i = 0
    
'Segment CheckIfProjectExists-02. Find modules in VBA and get name
    For Each VBAComp In ThisWorkbook.VBProject.VBComponents
        If VBAComp.Type = 1 Or VBAComp.Type = 2 Or VBAComp.Type = 3 Then
            MyModuleName = VBAComp.name
            On Error Resume Next
            Set MyModule = ActiveWorkbook.VBProject.VBComponents(MyModuleName).CodeModule
            If Err.Number <> 0 Then
                MsgBox ("Module : " & MyModuleName & vbCr & "does not exist.")
                Exit Sub
            Else
            
'Segment CheckIfProjectExists-03. In each module find projects and verify non-existing  code for projects to remark them in CONFIG
                For j = 1 To 100
                    MySub = "Project_" & j & "_" & ProjLang
                    MyLine1 = 0
                    MyLine1 = MyModule.ProcStartLine(MySub, vbext_pk_Proc)
                        If MyLine1 <> 0 Then
                            If i < j - 1 Then
                                For i = i To j - 2
                                    If i < 3 Or i = 14 Then
                                        If i = 14 Then Worksheets("CONFIG").Cells(33 + i, 4 + LangCode).Value = "TRAJECTORY"
                                    Else
                                        Worksheets("CONFIG").Cells(33 + i, 4 + LangCode).Value = "-- Empty --"
                                    End If
                                Next i
                            End If
                            
'Segment CheckIfProjectExists-04. Configure how the project title automatically appears in the project list.
    '...Lines(MyLine1, 5), 5 is the number of lines to take into account after the comment to capture the title. If no title appears it may be because there is too much space between Sub and Sub.
    '...vbTextCompare) + 7, 25) 7 = initial character from the parenthesis before the apostrophe; 25 = final character. example: Sub Project_30_EN(ByVal VecType, m, n, m1, n1 As Integer) '  30_Field of nuclear particl
                            If Worksheets("CONFIG").Cells(33 + i, 4 + LangCode).Value = "" Or Worksheets("CONFIG").Cells(33 + i, 4 + LangCode).Value = "-- Empty --" Then
                                ProjLongName = Mid(MyModule.Lines(MyLine1, 5), InStr(50, MyModule.Lines(MyLine1, 5), ")", vbTextCompare) + 7, 25)
                                ProjLongName = Replace(ProjLongName, "'", "", 1, -1)
                                Worksheets("CONFIG").Cells(33 + i, 4 + LangCode).Value = Replace(ProjLongName, Chr(10), "", 1, -1)
                            End If
                            i = j
                        End If
                        
'Segment CheckIfProjectExists-05. Check if the selected project exists (true)
                        If flag = True Then GoTo siguiente
                        If MySub = "Project_" & MySubReference & "_" & ProjLang Then
                            MyLine = MyModule.ProcStartLine(MySub, vbext_pk_Proc)
                            If MyLine <> 0 Then
                                flag = True
                            End If
                        End If
siguiente:
                Next j
            End If
        End If
    Next
    
'Segment CheckIfProjectExists-05. Review and correct the numbers in the project list in CONFIG and notify if the project you are trying to download does not exist.
    For j = 2 To i
        Worksheets("CONFIG").Cells(32 + j, 3).Value = j
        Worksheets("CONFIG").Cells(32 + j, 2).FormulaR1C1 = "=HLOOKUP(R2C17,R33C5:R150C11,RC[1])"
    Next j
    Worksheets("CONFIG").Range(Worksheets("CONFIG").Cells(32 + i + 1, 3), Worksheets("CONFIG").Cells(32 + i + 100, 3)).Clear
    Worksheets("CONFIG").Range(Worksheets("CONFIG").Cells(32 + i + 1, 3), Worksheets("CONFIG").Cells(32 + i + 100, 2)).Clear
    If MyLine = 0 And MySubReference > 2 Then
        If MySubReference <> "" Then
            MsgBox "The project code " & MySubReference & " does not exist. "
        End If
    End If
End Sub
Function GetDynamicColorStops(sliderPos As Double) As Variant()
'Function to construct gradient color for fields.
    ' Base gradient blue-green-yellow-red
    Dim baseStops() As Variant
    baseStops = Array( _
        Array(0, 255, 0, 0), _
        Array(0.2, 255, 100, 0), _
        Array(0.4, 255, 255, 0), _
        Array(0.6, 0, 255, 0), _
        Array(0.75, 0, 255, 255), _
        Array(0.9, 0, 100, 255), _
        Array(1, 0, 0, 255))
    
    ' Adjust gradient according to sliderPos (cell C6 or equivalent)
    Select Case sliderPos
        Case 0 To 0.2 ' More blue
            GetDynamicColorStops = Array( _
            Array(0, 255, 0, 0), _
            Array(0.2, 255, 100, 0), _
            Array(0.4, 255, 255, 0), _
            Array(0.6, 0, 255, 0), _
            Array(0.75, 0, 255, 255), _
            Array(0.9, 0, 150, 255), _
            Array(1, 0, 100, 255))
                
        Case 0.21 To 0.4 ' More green
            GetDynamicColorStops = Array( _
                Array(0, 255, 0, 0), _
                Array(0.2, 200, 150, 0), _
                Array(0.4, 200, 200, 0), _
                Array(0.6, 50, 200, 50), _
                Array(0.75, 0, Int(230 * sliderPos), Int(255 * sliderPos)), _
                Array(0.9, 0, Int(190 * sliderPos), Int(255 * sliderPos)), _
                Array(1, 0, Int(70 * sliderPos), Int(255 * sliderPos)))

        Case 0.41 To 0.6 ' Colored, equipotential surfaces
            GetDynamicColorStops = Array( _
                Array(0#, 255, 0, 0), _
                Array(0.05, 240, 240, 5), _
                Array(0.1, 200, 100, 0), _
                Array(0.15, 190, 0, 40), _
                Array(0.2, 200, 255, 10), _
                Array(0.25, 125, 0, 25), _
                Array(0.3, 70, 100, 125), _
                Array(0.35, 75, 255, 0), _
                Array(0.4, 100, 0, 20), _
                Array(0.45, 0, 255, 0), _
                Array(0.5, 128, 100, 130), _
                Array(0.55, 0, 255, 150), _
                Array(0.6, 130, 140, 255), _
                Array(0.65, 50, 50, 100), _
                Array(0.7, 0, 240, 100), _
                Array(0.75, 255, 0, 255), _
                Array(0.8, 0, 255, 255), _
                Array(0.85, 0, 100, 255), _
                Array(0.9, 255, 0, 255), _
                Array(1#, 0, 0, 255))
                
        Case 0.61 To 0.8 ' Black and white, equipotential surfaces
            GetDynamicColorStops = Array( _
                Array(0#, 255, 255, 255), Array(0.05, 0, 0, 0), _
                Array(0.1, 255, 255, 255), Array(0.13, 0, 0, 0), _
                Array(0.15, 255, 255, 255), Array(0.18, 0, 0, 0), _
                Array(0.2, 255, 255, 255), Array(0.23, 0, 0, 0), _
                Array(0.25, 255, 255, 255), Array(0.28, 0, 0, 0), _
                Array(0.3, 255, 255, 255), Array(0.33, 0, 0, 0), _
                Array(0.35, 255, 255, 255), Array(0.38, 0, 0, 0), _
                Array(0.4, 255, 255, 255), Array(0.43, 0, 0, 0), _
                Array(0.45, 255, 255, 255), Array(0.48, 0, 0, 0), _
                Array(0.5, 255, 255, 255), Array(0.53, 0, 0, 0), _
                Array(0.55, 255, 255, 255), Array(0.58, 0, 0, 0), _
                Array(0.6, 255, 255, 255), Array(0.63, 0, 0, 0), _
                Array(0.65, 255, 255, 255), Array(0.68, 0, 0, 0), _
                Array(0.7, 255, 255, 255), Array(0.73, 0, 0, 0), _
                Array(0.75, 255, 255, 255), Array(0.78, 0, 0, 0), _
                Array(0.8, 255, 255, 255), Array(0.83, 0, 0, 0), _
                Array(0.85, 255, 255, 255), Array(0.88, 0, 0, 0), _
                Array(0.9, 255, 255, 255), Array(0.93, 0, 0, 0), _
                Array(0.95, 255, 255, 255), Array(0.98, 0, 0, 0), _
                Array(1, 255, 255, 255))
        
        Case Else ' opposite gradient
            GetDynamicColorStops = Array( _
                Array(0#, 0, 100, 255), _
                Array(0.2, 50, 200, 100), _
                Array(0.4, 150, 255, 50), _
                Array(0.6, 255, 255, 0), _
                Array(1#, 255, 0, 0))
    End Select
End Function

Function GetGradientColor(normalizedValue As Double, colorStops() As Variant) As Long

    ' Validar el rango de entrada
    If normalizedValue < 0 Then normalizedValue = 0
    If normalizedValue > 1 Then normalizedValue = 1

    ' Encontrar el segmento adecuado
    Dim i As Integer
    For i = LBound(colorStops) To UBound(colorStops) - 1
        If normalizedValue >= colorStops(i)(0) And normalizedValue <= colorStops(i + 1)(0) Then
            ' Calcular posición relativa en el segmento (0 a 1)
            Dim t As Double
            t = (normalizedValue - colorStops(i)(0)) / (colorStops(i + 1)(0) - colorStops(i)(0))

            ' Interpolar linealmente entre los colores
            Dim r As Integer, g As Integer, B As Integer
            r = colorStops(i)(1) + t * (colorStops(i + 1)(1) - colorStops(i)(1))
            g = colorStops(i)(2) + t * (colorStops(i + 1)(2) - colorStops(i)(2))
            B = colorStops(i)(3) + t * (colorStops(i + 1)(3) - colorStops(i)(3))

            ' Asegurar que los valores estén en el rango correcto (0-255)
            r = Application.WorksheetFunction.max(0, Application.WorksheetFunction.Min(255, r))
            g = Application.WorksheetFunction.max(0, Application.WorksheetFunction.Min(255, g))
            B = Application.WorksheetFunction.max(0, Application.WorksheetFunction.Min(255, B))

            GetGradientColor = RGB(r, g, B)
            Exit Function
        End If
    Next i

    ' Valor por defecto (no debería llegar aquí si el input está normalizado)
    GetGradientColor = RGB(150, 150, 150)
End Function