Attribute VB_Name = "ServiceDbf"
Option Explicit

Public Const LOCALE_USER_DEFAULT = &H400
Public Const LOCALE_DECIMAL = &HE
Public oODBC, oConnect, oComBarDbf

#If Win64 Then
    Public Declare PtrSafe Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
    Public Declare PtrSafe Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long
    Public Declare PtrSafe Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
    Public Declare PtrSafe Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
#Else
    Public Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
    Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long
    Public Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
    Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
#End If


'**********************************************************************************************************
' главная инициализация
Function MainInit(ByVal cMode As String) As Integer
    Dim bFound As Boolean, oComBar As Object, oBook As Workbook, oSheet As Worksheet
    
    ' cMode - режим работы
    ' 1 - полный цикл
    ' 2 - урезанный, без защиты страниц
    cMode = VBA.Trim(cMode)
    
    Set oBook = Application.ActiveWorkbook
    If Not Application.ScreenUpdating And Not Application.DisplayAlerts Then
        For Each oSheet In oBook.Worksheets
            Call SheetParseFoxComments(oSheet)
            If cMode = "1" Then
                Call SheetProtect(oSheet)
            End If
        Next oSheet
    End If
    
    bFound = False
    For Each oComBar In Application.CommandBars
        If oComBar.Name = "BKS_MENU_DBF" Then bFound = True
    Next
    If bFound Then Application.CommandBars("BKS_MENU_DBF").Delete

    Set oComBarDbf = CommandBars.Add(Name:="BKS_MENU_DBF", Position:=msoBarTop, Temporary:=True)
    With oComBarDbf.Controls.Add(Type:=msoControlButton)
        .FaceId = 266
        .Style = msoButtonIcon
        .Caption = "Сохранить данные отчета в DBF-файл"
        .OnAction = "OdbcUpdateDbf"
    End With
    
    oComBarDbf.Enabled = True
    oComBarDbf.Visible = True

    MainInit = 1
End Function
' ODBC коннект к Dbf-файлу
Function OdbcConnectDbf(ByVal cPathDbf As String) As Boolean
    OdbcConnectDbf = False
    On Error GoTo doError
    
    Set oODBC = CreateWorkspace("", "", "", dbUseODBC)
    Set oConnect = oODBC.OpenConnection("", 0, , _
        "ODBC; Driver={Microsoft Visual FoxPro Driver}; SourceType=DBF; SourceDB=" + cPathDbf + "; " _
        + "Exclusive=NO; Collate=Machine; NULL=NO; DELETED=NO; BACKGROUNDFETCH=NO; ")
    
    OdbcConnectDbf = True
    Exit Function
    
doError:
    Call ERROR_EVENT("OdbcConnectDbf")
End Function
' ODBC изменение (обновление) Dbf-файла
Sub OdbcUpdateDbf()
    Dim oBook As Workbook, oSheet As Worksheet, cLogFile As String, cFileDbf As String _
        , cFoxCode As String, nIdx As Long, cAddr As String, cThis As String _
        , cThisChar As String, WshShell, RetVal, cCmd As String, nAnswer As Long _
        , nError As Long, nCnt As Long, cThisDbf As String, cPathDbf As String _
        , aFileDbf() As String, aFileSave() As String, bFound As Boolean _
        , cFileSave As String, oFolder
    
    On Error GoTo doError
    
    nError = 0
    Set WshShell = CreateObject("WScript.Shell")
    Set oBook = Application.ActiveWorkbook
    
    cLogFile = GetPathShort(GetPathWorkKS()) + "save_dbf.log"   ' файл статистики
    Call PrintFile(cLogFile, 0, "")
    Call PrintFile(cLogFile, 1, "Версия MS Excel: " + GetExcelVersion())
    Call PrintFile(cLogFile, 1, "Книга MS Excel: " + oBook.Name)
    
    If Not testRef() Then
        Call PrintFile(cLogFile, 1, VBA.String(20, "-"))
        Call PrintFile(cLogFile, 1, "ОШИБКА: Отсутствует библиотека DAO, работа невозможна.")
        nError = (nError Or 1)
        GoTo ExitSub
    End If
    
    For Each oSheet In oBook.Sheets
        Call PrintFile(cLogFile, 1, VBA.String(20, "-"))
        Call PrintFile(cLogFile, 1, "Обработка страницы: """ + oSheet.Name + """.", True)
        cFileDbf = ScriptGet(oSheet, "SAVED_DBF_NAME")
        
        If VBA.Dir(cFileDbf) <> "" Then
            bFound = False
            If CheckArray(aFileDbf) Then
                For nCnt = 0 To UBound(aFileDbf, 1)
                    If aFileDbf(nCnt) = cFileDbf Then
                        bFound = True
                        Exit For
                    End If
                Next nCnt
            End If
            
            cFileSave = ""
            If Not bFound Then
                oFolder = Application.GetSaveAsFilename( _
                    InitialFileName:="user_data.dbf", _
                    FileFilter:="Microsoft Visual FoxPro Table,*.dbf", _
                    Title:="Сохранение данных в DBF-файл")
                
                If oFolder <> False Then
                    cFileSave = oFolder
                End If
                
                If cFileSave <> "" Then
                    If Not CheckArray(aFileDbf) Then
                        ReDim Preserve aFileDbf(0), aFileSave(0)
                    Else
                        ReDim Preserve aFileDbf(UBound(aFileDbf, 1) + 1), aFileSave(UBound(aFileSave, 1) + 1)
                    End If
                    
                    aFileDbf(UBound(aFileDbf, 1)) = cFileDbf
                    aFileSave(UBound(aFileSave, 1)) = cFileSave
                    
                    If VBA.Dir(cFileSave) <> "" Then
                        Call VBA.Kill(cFileSave)
                    End If
                    Call VBA.FileCopy(cFileDbf, cFileSave)
                    
                    If VBA.Dir(VBA.Replace(cFileDbf, ".dbf", ".fpt")) <> "" Then
                        If VBA.Dir(VBA.Replace(cFileSave, ".dbf", ".fpt")) <> "" Then
                            Call VBA.Kill(VBA.Replace(cFileSave, ".dbf", ".fpt"))
                        End If
                        Call VBA.FileCopy(VBA.Replace(cFileDbf, ".dbf", ".fpt"), VBA.Replace(cFileSave, ".dbf", ".fpt"))
                    End If
                End If
            Else
                cFileSave = aFileSave(nCnt)
                
                If Not VBA.Dir(cFileSave) <> "" Then
                    Call VBA.FileCopy(cFileDbf, cFileSave)
                End If
            
                If VBA.Dir(VBA.Replace(cFileDbf, ".dbf", ".fpt")) <> "" And Not VBA.Dir(VBA.Replace(cFileSave, ".dbf", ".fpt")) <> "" Then
                    Call VBA.FileCopy(VBA.Replace(cFileDbf, ".dbf", ".fpt"), VBA.Replace(cFileSave, ".dbf", ".fpt"))
                End If
            End If
            
            If cFileSave <> "" Then
                nCnt = 0
                Do While VBA.InStr(nCnt + 1, cFileSave, "\") > 0
                    nCnt = VBA.InStr(nCnt + 1, cFileSave, "\")
                Loop
                
                If nCnt = 0 Then
                    cThisDbf = cFileSave
                    cPathDbf = ""
                Else
                    cThisDbf = VBA.Mid(cFileSave, nCnt + 1, 10000)
                    cPathDbf = VBA.Left(cFileSave, nCnt - 1)
                End If
            End If
            
            If VBA.Dir(cFileSave) <> "" Then
                ' подключение к dbf-файлу
                If OdbcConnectDbf(cPathDbf) Then
                    ' обработка dbf-файла
                    Call PrintFile(cLogFile, 1, "Сохранение данных страницы в файл: """ + cFileSave + """.")
                    Call PrintFile(cLogFile, 1, "Выполняемый список команд:")
                    For nIdx = 1 To oSheet.Scripts.Count
                        cFoxCode = ""
                        
                        If VBA.InStr(oSheet.Scripts(nIdx).ID, "fox_term_") > 0 Then
                            cAddr = VBA.Mid(oSheet.Scripts(nIdx).ID, 1 + VBA.Len("fox_term_"))
                            If Not VBA.IsError(oSheet.Range(cAddr).Value) Then
                                If VBA.Trim(oSheet.Range(cAddr).Value) <> "" And oSheet.Range(cAddr).Value <> 0 Then
                                    cThis = VBA.Replace(VBA.Format(VBA.Val(VBA.Trim(VBA.Replace(oSheet.Range(cAddr).Value, ",", "."))), "#.000000"), ",", ".")
                                    cThis = VBA.IIf(cThis = "", "0.000000", cThis)
                                    cThisChar = "" & VBA.Trim(oSheet.Range(cAddr).Value) & ""
                                    
                                    If VBA.IsNumeric(oSheet.Range(cAddr).Value) Then
                                        cThisChar = ".null."
                                    Else
                                        cThis = ".null."
                                    End If
                                    
                                    cFoxCode = VBA.Replace( _
                                                    VBA.Replace( _
                                                        VBA.Replace( _
                                                            oSheet.Scripts(nIdx).ScriptText _
                                                            , "thisdbf" _
                                                            , cThisDbf) _
                                                        , "thischar" _
                                                        , cThisChar) _
                                                    , "this" _
                                                    , cThis)
                                End If
                            End If
                        End If
                        
                        If cFoxCode <> "" Then
                            Call PrintFile(cLogFile, 1, cFoxCode)
                            oConnect.Execute cFoxCode, 2048
                        End If
                    Next nIdx
                Else
                    Call PrintFile(cLogFile, 1, "ОШИБКА: Невозможно подключится к файлу """ + cFileSave + """.")
                    nError = (nError Or 4)
                End If
            Else
                Call PrintFile(cLogFile, 1, "Сохранение страницы """ + oSheet.Name + """ пропущено пользователем.")
                nError = (nError Or 8)
            End If
        Else
            Call PrintFile(cLogFile, 1, "ОШИБКА: Отсутствует файл подключения """ + cFileDbf + """.")
            nError = (nError Or 2)
        End If
        
        Set oConnect = Nothing
        Application.StatusBar = False
    Next oSheet
    
ExitSub:
    Set oConnect = Nothing
    Application.StatusBar = False
    
    oBook.Saved = True
    nAnswer = VBA.MsgBox("Операция завершена." _
        + VBA.IIf((nError And 1) = 1, VBA.vbNewLine + "ОШИБКА: Отсутствует библиотека DAO, работа невозможна.", "") _
        + VBA.IIf((nError And 2) = 2, VBA.vbNewLine + "Имеются отсутствующие файлы подключения.", "") _
        + VBA.IIf((nError And 4) = 4, VBA.vbNewLine + "Имеются файлы подключения с ошибкой.", "") _
        + VBA.IIf((nError And 8) = 8, VBA.vbNewLine + "Имеются пропущенные пользователем страницы.", "") _
        + VBA.vbNewLine + "Протокол приема смотрите в файле:" _
        + VBA.vbNewLine + cLogFile _
        + VBA.vbNewLine + "Открыть файл для просмотра?" _
        , VBA.vbYesNo + VBA.vbDefaultButton2 + VBA.vbInformation, "Внимание")
    If nAnswer = 6 Then
        cCmd = "notepad.exe " + cLogFile
        RetVal = WshShell.Run(cCmd, 1, False)
    End If
    
    Exit Sub

doError:
    Set oConnect = Nothing
    Application.StatusBar = False
    
    Call ERROR_EVENT("OdbcUpdateDbf")
End Sub
' разбор Visual FoxPro комментариев-конструкций
Sub SheetParseFoxComments(Optional ByVal oSheet As Worksheet = Nothing)
    Dim Com As Comment, cParam As String
    
    If oSheet Is Nothing Then
        Set oSheet = Application.ActiveSheet
    End If
    
    Application.Calculation = xlManual
    For Each Com In oSheet.Comments
        cParam = VBA.Lcase(VBA.Trim(GetStrParam(Com.Text, 1)))
        
        If cParam = "fox_term" Then
            cParam = VBA.Trim(GetStrParam(Com.Text, 2))
            If cParam <> "" Then
                Call ScriptSet(oSheet, "fox_term_" + Com.Parent.Address(), cParam, True)
            End If
            Com.Parent.ClearComments
        End If
    Next Com
    Application.Calculation = xlCalculationAutomatic
End Sub
' защита страницы
Sub SheetProtect(Optional ByVal oSheet As Worksheet = Nothing)
    Dim cValue As String
    
    If oSheet Is Nothing Then
        Set oSheet = Application.ActiveSheet
    End If
    
    VBA.Randomize
    cValue = MkChar(VBA.Int(VBA.Rnd() * 100000) * 10000 + VBA.Int(VBA.Rnd() * 100000), 10)

    If oSheet.Name <> "Service" And oSheet.Name <> "Данные" And oSheet.Name <> "Документ" Then
        Call ScriptSet(oSheet, "protect_term", cValue, True)
        
        If VBA.Val(Application.Version) = 9 Then
            oSheet.Protect Password:=cValue, DrawingObjects:=True, Contents:=True, Scenarios:=True
        End If
        
        If VBA.Val(Application.Version) > 9 Then
            Call SheetProtectAfter9(oSheet, cValue)
        End If
    End If
End Sub
' защита страницы версий выше 9 (от XP (2002) включая)
Sub SheetProtectAfter9(ByVal oSheet As Worksheet, ByVal cValue As String)
    oSheet.Protect Password:=cValue, DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering:=True
End Sub
'**********************************************************************************************************
' каталог по умолчания MS Excel
Private Function GetPathDef() As String
    Dim cPath As String

    cPath = Application.DefaultFilePath
    cPath = cPath + VBA.IIf(VBA.Right(cPath, 1) <> "\", "\", "")
    GetPathDef = cPath
End Function
' короткое системное наименование путей
Private Function GetPathShort(cFileName As String) As String
    Dim nRes As Long, cPath As String
    
    cPath = VBA.String$(255, 0)
    nRes = GetShortPathName(cFileName, cPath, 254)
    GetPathShort = VBA.Left$(cPath, nRes)
End Function
' системный каталог MS Windows "system32"
Private Function GetPathSys() As String
    Dim cPath As String, nRet As Long
    
    cPath = VBA.Space(255)
    nRet = GetSystemDirectory(cPath, 255)
    cPath = VBA.Trim(VBA.Left$(cPath, nRet))
    cPath = cPath + VBA.IIf(VBA.Right(cPath, 1) <> "\", "\", "")
    GetPathSys = cPath
End Function
' временный каталог MS Windows
Private Function GetPathTmp() As String
    Dim cPath As String
    
    cPath = VBA.String(100, VBA.Chr$(0))
    Call GetTempPath(100, cPath)
    cPath = VBA.Trim(VBA.Left$(cPath, VBA.InStr(cPath, VBA.Chr$(0)) - 1))
    cPath = cPath + VBA.IIf(VBA.Right(cPath, 1) <> "\", "\", "")
    GetPathTmp = cPath
End Function
' формируем временный каталог для нужд книги
Private Function GetPathWorkKS() As String
    Dim cPath As String, cPathShort As String
    
    cPath = GetPathTmp()
    cPathShort = GetPathShort(cPath)
    
    If VBA.InStr(cPathShort, " ") > 0 Then
        cPath = GetPathDef()
        cPathShort = GetPathShort(cPath)
    End If

    If Not VBA.Dir(cPathShort, vbDirectory) <> "" Then
        cPath = GetPathDef()
        cPathShort = GetPathShort(cPath)
        If Not VBA.Dir(cPathShort, vbDirectory) <> "" Then
            cPath = "c:\"
            cPathShort = cPath
        End If
    End If
    
    If VBA.Dir(cPathShort, vbDirectory) <> "" Then
        cPathShort = cPathShort + "ks\"
        If Not VBA.Dir(cPathShort, vbDirectory) <> "" Then
            Call VBA.MkDir(cPathShort)
        End If
        
        If VBA.Dir(cPathShort, vbDirectory) <> "" Then
            cPath = cPath + "ks\"
            cPathShort = cPathShort + "excel\"
            If Not VBA.Dir(cPathShort, vbDirectory) <> "" Then
                Call VBA.MkDir(cPathShort)
            End If
            
            If VBA.Dir(cPathShort, vbDirectory) <> "" Then
                cPath = cPath + "excel\"
            End If
        End If
    Else
        cPath = "c:\"
    End If
    GetPathWorkKS = cPath
End Function
'**********************************************************************************************************
' проверить: aTest - массив
Function CheckArray(ByRef aTest As Variant) As Boolean
    Dim nBound As Long, bIsArray As Boolean
    
    bIsArray = False
    If VBA.IsArray(aTest) Then
        On Error GoTo NotArr
        nBound = UBound(aTest, 1)
        bIsArray = True
    End If

NotArr:
    On Error GoTo 0
    
    CheckArray = bIsArray
End Function
' получение версии MS Excel
Private Function GetExcelVersion() As String
    Dim nVersion As Double, cVersion As String
    
    nVersion = VBA.Val(Application.Version)
    Select Case nVersion
    Case 12
        cVersion = "2007"
    Case 11
        cVersion = "2003"
    Case 10
        cVersion = "XP (2002)"
    Case 9
        cVersion = "2000"
    Case Else
        cVersion = "Версия " + VBA.str(nVersion)
    End Select
    GetExcelVersion = "Microsoft Office Excel " + cVersion
End Function
' получение пользовательской региональной настройки
Private Function GetLocalInfo(ByVal nInfo As Long) As String
    Dim cBuffer As String, nRet As String
    
    cBuffer = VBA.String$(256, 0)
    nRet = GetLocaleInfo(LOCALE_USER_DEFAULT, nInfo, cBuffer, VBA.Len(cBuffer))
    
    GetLocalInfo = VBA.Trim(VBA.IIf(nRet > 0, VBA.Left$(cBuffer, nRet - 1), ""))
End Function
' функция, возвращает указанный параметр из строки параметров
Private Function GetStrParam(ByVal cParam As String, ByVal nParam As Integer, Optional cPart As String = "#") As String
    Dim nPos1 As Integer, nPos2 As Integer, i As Long
    
    nPos1 = 0
    i = 1
    While i < nParam
        nPos1 = VBA.InStr(nPos1 + 1, cParam, cPart)
        If nPos1 = 0 Then
            GetStrParam = ""
            Exit Function
        End If
        i = i + 1
    Wend
    nPos2 = VBA.InStr(nPos1 + 1, cParam, cPart)
    nPos2 = VBA.IIf(nPos2 = 0, VBA.Len(cParam), nPos2 - 1)
    If nPos2 > nPos1 Then
        GetStrParam = VBA.Mid(cParam, nPos1 + 1, nPos2 - nPos1)
    Else
        GetStrParam = ""
    End If
End Function
' вывод строки в файл
Private Sub PrintFile(ByVal cFile As String, ByVal nMode As Integer, ByVal cText As String _
        , Optional ByVal bStatusBar As Boolean = False)
    If cFile = "" Then Exit Sub
    If nMode = 0 Then
        Open cFile For Output As #1
    Else
        Open cFile For Append As #1
    End If
    Print #1, cText
    Close #1
    
    If bStatusBar Then
        Application.StatusBar = cText
    End If
End Sub
' поиск листа в книге
Private Function SheetExists(ByVal oBook As Workbook, ByVal cName As String) As Boolean
    Dim oSheet As Worksheet, bFlag As Boolean
    
    bFlag = False
    For Each oSheet In oBook.Sheets
        If oSheet.Name = cName Then bFlag = True
    Next oSheet
    SheetExists = bFlag
End Function
'**********************************************************************************************************
' поиск НАИМЕНОВАНИЯ в книге
Private Function NamesExistsBook(ByVal oBook As Workbook, cName As String) As Boolean
    Dim i As Integer
    
    For i = 1 To oBook.Names.Count
        If oBook.Names(i).Name = cName Then
            NamesExistsBook = True
            Exit Function
        End If
    Next
    NamesExistsBook = False
End Function
' поиск НАИМЕНОВАНИЯ на листе
Private Function NamesExistsSheet(ByVal oSheet As Worksheet, ByVal cName As String) As Boolean
    Dim i As Integer
    
    If cName <> "" Then
        For i = 1 To oSheet.Names.Count
            If VBA.UCase(VBA.Mid(oSheet.Names(i).Name, VBA.InStr(oSheet.Names(i).Name, "!") + 1)) = VBA.UCase(cName) Then
                NamesExistsSheet = True
                Exit Function
            End If
        Next
    End If
    NamesExistsSheet = False
End Function
' удаление НАИМЕНОВАНИЯ на листе
Private Sub NamesSheetDelete(ByVal oSheet As Worksheet, ByVal cName As String)
    If NamesExistsSheet(oSheet, cName) Then
        oSheet.Names(cName).Delete
    End If
End Sub
' добавление НАИМЕНОВАНИЯ в лист
Private Sub NamesSheetInsert(ByVal oSheet As Worksheet, ByVal cName As String, ByVal cAddress As String)
    If Not NamesExistsSheet(oSheet, cName) Then
        oSheet.Names.Add Name:=cName, RefersTo:="=" & oSheet.Name & "!" & cAddress
    Else
        oSheet.Names(cName).RefersTo = "=" & oSheet.Name & "!" & cAddress
    End If
End Sub
' переименование НАИМЕНОВАНИЯ на листе
Private Sub NamesSheetRename(ByVal oSheet As Worksheet, ByVal cNameOld As String, ByVal cNameNew As String)
    If NamesExistsSheet(oSheet, cNameOld) Then
        oSheet.Names(cNameOld).Name = cNameNew
    End If
End Sub
' получить значение НАИМЕНОВАНИЯ на листе или в книге
Private Function NamesSheetValue(ByVal oSheet As Worksheet, ByVal cName As String) As String
    NamesSheetValue = ""
    If NamesExistsSheet(oSheet, cName) Then
        NamesSheetValue = VBA.Trim(VBA.CStr(oSheet.Names(cName).RefersToRange.Value))
    Else
        If NamesExistsBook(oSheet.Parent, cName) Then
            NamesSheetValue = VBA.Trim(VBA.CStr(oSheet.Parent.Names(cName).RefersToRange.Value))
        End If
    End If
End Function
'**********************************************************************************************************
' ScriptExists
Private Function ScriptExists(ByVal oSheet As Worksheet, ByVal cIDScript As String) As Boolean
    Dim bRes As Boolean, n As Long
    
    bRes = False
    cIDScript = VBA.Trim(cIDScript)
    
    For n = 1 To oSheet.Scripts.Count
        If VBA.UCase(VBA.Trim(oSheet.Scripts(n).ID)) = VBA.UCase(VBA.Trim(cIDScript)) Then
            bRes = True
        End If
    Next n
    
    ScriptExists = bRes
End Function
' ScriptGet
Private Function ScriptGet(ByVal oSheet As Worksheet, ByVal cIDScript As String) As String
    Dim cRes As String

    cRes = ""
    cIDScript = VBA.Trim(cIDScript)
    
    If ScriptExists(oSheet, cIDScript) Then
        cRes = VBA.Trim(oSheet.Scripts(cIDScript).ScriptText)
    End If
    
    ScriptGet = cRes
End Function
' ScriptSet
Private Sub ScriptSet(ByVal oSheet As Worksheet, ByVal cIDScript As String, ByVal cValueScript As String _
        , Optional ByVal bAlwaysAdd As Boolean = False)
    cIDScript = VBA.Trim(cIDScript)
    cValueScript = VBA.Trim(cValueScript)
    
    If bAlwaysAdd Or Not ScriptExists(oSheet, cIDScript) Then
        oSheet.Scripts.Add Location:=2, Language:=2, ID:=cIDScript, ScriptText:=cValueScript
    Else
        oSheet.Scripts(cIDScript).ScriptText = cValueScript
    End If
End Sub
'**********************************************************************************************************
