背景色を変更・復元する

ﾀｲﾄﾙが異なりますが、こちらの続きです。
画面ｷｬﾌﾟﾁｬをｸﾘｯﾌﾟﾎﾞｰﾄﾞに保存する - C#ATIA

単に背景色を切り替えるﾏｸﾛです。
但し元の背景色に復元出来る様に、変更前の背景色RGBをﾊﾟﾗﾒｰﾀに
保存しています。
(外部ﾌｧｲﾙや何処かのﾌﾟﾛﾊﾟﾃｨに書き出すより、自然かと思います)

'vba sample_ChangeBackColor ver0.0.1 by Kantoku
'CATIAの背景色を変更・復元

Option Explicit

'背景色をﾊﾞｯｸｱｯﾌﾟするﾊﾟﾗﾒｰﾀ名
Private Const BACKCOLOR_PRAM_NAME = "BackColorRGB"

'変更後背景色
Private Const BACKCOLOR = "255,255,255"

Sub CATMain()
    Dim Doc As Document
    Set Doc = CATIA.ActiveDocument
    
    Dim Msg As String
    
    Dim Prms As Parameters
    Set Prms = Get_Prms(Doc)
    If Prms Is Nothing Then
        Msg = "ProductかPartで使用してください"
        MsgBox Msg
        Exit Sub
    End If
    
    Msg = "背景色を変更しますか?" & vbNewLine & _
        "はい : 背景色を変更(RGB:" & BACKCOLOR & ")" & vbNewLine & _
        "いいえ : ﾊﾞｯｸｱｯﾌﾟしている背景色に復元" & vbNewLine & _
        "ｷｬﾝｾﾙ : 中止"
            
    Select Case MsgBox(Msg, vbYesNoCancel + vbQuestion)
        Case vbYes
            Call ChangeBackColor(Prms) '白に変更
        Case vbNo
            Call RestorationBackColor(Prms) '復元
        Case Else
            Exit Sub
    End Select
    
End Sub

'復元
Sub RestorationBackColor(ByVal Prms As Parameters)
    Dim Msg As String
    
    If Not Is_ExistsPrm(Prms, BACKCOLOR_PRAM_NAME) Then
        Msg = "ﾊﾞｯｸｱｯﾌﾟしている背景色が有りませんでした"
        MsgBox Msg, vbOKOnly + vbExclamation
        Exit Sub
    End If
    
    Dim Prm As StrParam
    Set Prm = Prms.Item(BACKCOLOR_PRAM_NAME)
    
    If Not Is_RGB_Str(Prm.Value) Then
        Msg = "ﾊﾞｯｸｱｯﾌﾟしている背景色ﾊﾟﾗﾒｰﾀが不正です"
        MsgBox Msg, vbOKOnly + vbExclamation
        Exit Sub
    End If
    
    Call Update_BackRGB(Prm.Value)
    
    Dim Sel As Selection
    Set Sel = CATIA.ActiveDocument.Selection
    With Sel
        .Clear
        .Add Prm
        .Delete
    End With
End Sub

'BACKCOLORに変更
Private Sub ChangeBackColor(ByVal Prms As Parameters)
    Dim Msg As String
    
    Dim Prm As StrParam
    If Is_ExistsPrm(Prms, BACKCOLOR_PRAM_NAME) Then
        Set Prm = Prms.Item(BACKCOLOR_PRAM_NAME)
        
        Msg = "既に背景色のﾊﾞｯｸｱｯﾌﾟがありますが、" & _
            "作業を続けますか?" & vbNewLine & _
            "はい : 新たにﾊﾞｯｸｱｯﾌﾟし、作業を進める" & vbNewLine & _
            "いいえ : ﾊﾞｯｸｱｯﾌﾟは変更せず、作業を進める" & vbNewLine & _
            "ｷｬﾝｾﾙ : 中止"
            
        Select Case MsgBox(Msg, vbYesNoCancel + vbQuestion)
            Case vbYes
                Prm.Value = Get_BackRGB_ToStr()
            Case vbNo
                '何もしない
            Case Else
                Exit Sub
        End Select
    Else
        Set Prm = Prms.CreateString(BACKCOLOR_PRAM_NAME, "")
        Prm.Value = Get_BackRGB_ToStr()
    End If
    
    Call Update_BackRGB(BACKCOLOR)
    'Prm.Hidden = True '非表示
End Sub


' --- ｻﾎﾟｰﾄ関数 ---
Private Function Is_RGB_Str(ByVal Str As String) As Boolean
    Is_RGB_Str = False
    
    Dim Ary As Variant
    Ary = Split(Str, ",")
    If Not UBound(Ary) = 2 Then Exit Function
    
    Dim i As Long
    For i = 0 To 2
        If Not IsNumeric(Ary(i)) Then Exit Function
        If Not Ary(i) = CLng(Ary(i)) Then Exit Function
    Next
    
    Is_RGB_Str = True
End Function

Private Sub Update_BackRGB(ByVal RGB_Str As String)
    Dim VisSetAtt As VisualizationSettingAtt
    Set VisSetAtt = CATIA.SettingControllers.Item( _
        "CATVizVisualizationSettingCtrl")
        
    Dim Rgb As Variant
    Rgb = Split(RGB_Str, ",")

    Call VisSetAtt.SetBackgroundRGB(Rgb(0), Rgb(1), Rgb(2))
    VisSetAtt.SaveRepository
End Sub

Private Function Get_BackRGB_ToStr() As String
    Dim VisSetAtt As VisualizationSettingAtt
    Set VisSetAtt = CATIA.SettingControllers.Item( _
        "CATVizVisualizationSettingCtrl")
    
    Dim ActColor(2) As Long
    Call VisSetAtt.GetBackgroundRGB( _
        ActColor(0), ActColor(1), ActColor(2))
    
    Get_BackRGB_ToStr = Join( _
        Array(ActColor(0), ActColor(1), ActColor(2)), ",")
End Function

Private Function Init_Prm(ByVal Prms As Parameters, _
                          ByVal Name As String) As Parameter
    Set Init_Prm = Prms.CreateString(BACKCOLOR_PRAM_NAME, "")
End Function

Private Function Is_ExistsPrm(ByVal Prms As Parameters, _
                              ByVal Name As String) As Boolean
    Dim Prm As Parameter
    
    On Error Resume Next
        Set Prm = Prms.Item(Name)
    On Error GoTo 0
    
    Is_ExistsPrm = Not (Prm Is Nothing)
    
    If Not TypeName(Prm) = "StrParam" Then
        Is_ExistsPrm = False
        '文字型ﾀｲﾌﾟじゃない同一名のﾊﾟﾗﾒｰﾀがある- 未対応
    End If
End Function

Private Function Get_Prms(ByVal Doc As Document) As Parameters
    Set Get_Prms = Nothing
    Select Case TypeName(Doc)
        Case "ProductDocument"
            Set Get_Prms = Doc.Product.Parameters
        Case "PartDocument"
            Set Get_Prms = Doc.Part.Parameters
    End Select
End Function