Excel VBA - Pulizia Range (Clear range)

ITA: Semplifica la cancellazione di un range. Aggiunge alcuni metodi non disponibili:
- Cancellazione delle costanti (lascia intatte le formule)
- Cancellazione selettiva dei bordi
- Cancellazione selettiva degli attributi del font
- Cancellazione Colore del fotn e sfondo

ENG: Simplifies range cleaning. It adds some methods not availables
- Constants cleaning (leaves formulas)
- Selective deleteion of edges
- Selective deletion of font attributes
- Cancellation of the background color

'
' Pulisce il range specificato
' Mode è una stringa che può contenere uno p più dei seguenti caratteri:
'
' T=Tutto              (corrisonde al metodo Clear)
' C=Contenuto          (corrisonde al metodo ClearContents) 
' c=Commenti           (corrisonde al metodo ClearComments)  
' F=Formati            (corrisonde al metodo ClearFormats)  
' N=Note               (corrisonde al metodo ClearNotes)   
' H=Hyperlink          (corrisonde al metodo ClearHyperlinks)   
' O=Outline            (Struttura)
' V=Valori             (non cancella le formule)
' P=Paper color        (Colore sfondo)
' f=Font Attribute     Cancella gli attributi del font, è possibile specificare quali
'                      indicando una combinazione delle lettere [GCBAPSNDI] racchiuse tra []
'                      Grasetto/Corsivo/Barrato/Apice/Pedice/Sottolineato
'                      Nome font/Dimensioni font (ripristina i predefiniti)
'                      Inchiostro (colore del carattere)
' B=Bordi              Cancella i bordi, è possibile specificare quali
'                      indicando una combinazione delle lettere [LTBRVHDU] racchiuse tra []
'                      Left/Top/Bottom/Right; inside Vertical/Horizontal; diagonal Up/Down
'

' Clean specificed range
' Mode is a string than can containing ono or more of this chars:
'
' T=all                (equivalent to Clear          method)
' C=Contents           (equivalent to ClearContents  method)
' c=Comments           (equivalent to ClearComments  method) 
' F=Formats            (equivalent to ClearFormats   method)
' N=Notes              (equivalent to ClearNotes     method)
' H=Hyperlink          (equivalent to ClearHypelinks method)
' O=Outline            (equivalent to ClearOutline   method)
' V=Values             (clear only constants, leave formulas)
' P=Paper color        (clear background color of cells)
' f=Font Attribute     Clear font attributes. You can specify which indicating a combination 
'                      of the letters [GCBAPSNDI] enclosed in square barckets
'                      G=Bold/C=Italic/B=Strikethrough/A=Superscript/P=Subscript/S=Underlines
'                      N=Font Name/D=Font Size/I=Font Color (restore defaults)
' B=Borders            Clear borders. You can specify which indicating a combination 
'                      of the letters [LTBRVHDU] enclosed in square barckets
'                      L=Left/T=Top/B=Bottom/R=Right
'                      V=inside Vertical/H=inside Inside Horizontal
'                      U=diagonal Up/D=diagonal Down
'
Sub PuliziaRange(rRange As Range, Optional ByVal sMode As String = "C")
Dim sKeys As String

  With rRange
    Do Until sMode = Empty
      Select Case Left$(sMode, 1)
      Case "C"
        .ClearContents
      Case "c"
        .ClearComments
      Case "F"
        .ClearFormats
      Case "H"
        .ClearHyperlinks
      Case "N"
        .ClearNotes
      Case "O"
        .ClearOutline
      Case "V"
      ' Solo i valori, lascia le formule 
      ' Only values, leaves formulas
        Dim c As Range
        For Each c In .Cells
          If c.HasFormula = False Then c.ClearContents
        Next c
      Case "P"
        .Interior.ColorIndex = xlColorIndexNone
      Case "f" ' [GCBAPSNDI]
        sKeys = ""
        If Mid$(sMode, 2, 1) = "[" Then
          sKeys = Parse(Mid$(sMode, 3), "]")                ' clean flags for fonts 
          sMode = "f" & Mid$(TrimBefore(sMode, "]"), 2) ' Remove brackets 
        End If
      
        With .Font
          If KeyExist(sKeys, "G") Then .Bold = False
          If KeyExist(sKeys, "C") Then .Italic = False
          If KeyExist(sKeys, "B") Then .Strikethrough = False
          If KeyExist(sKeys, "A") Then .Superscript = False
          If KeyExist(sKeys, "P") Then .Subscript = False
          If KeyExist(sKeys, "S") Then .Underline = xlUnderlineStyleNone
          If KeyExist(sKeys, "F") Then .Name = Application.StandardFont
          If KeyExist(sKeys, "D") Then .Name = Application.StandardFontSize
          If KeyExist(sKeys, "I") Then .Name = .ColorIndex = xlAutomatic
        End With
        
      Case "B"      ' [LTBRVHDU]
        sKeys = ""
        If Mid$(sMode, 2, 1) = "[" Then
          sKeys = Parse(Mid$(sMode, 3), "]")                ' clean flags for bordes
          sMode = "B" & Mid$(TrimBefore(sMode, "]"), 2) ' Remove brackets 
        End If
        If KeyExist(sKeys, "D") Then .Borders(xlDiagonalDown).LineStyle = xlNone
        If KeyExist(sKeys, "U") Then .Borders(xlDiagonalUp).LineStyle = xlNone
        If KeyExist(sKeys, "L") Then .Borders(xlEdgeLeft).LineStyle = xlNone
        If KeyExist(sKeys, "T") Then .Borders(xlEdgeTop).LineStyle = xlNone
        If KeyExist(sKeys, "B") Then .Borders(xlEdgeBottom).LineStyle = xlNone
        If KeyExist(sKeys, "R") Then .Borders(xlEdgeRight).LineStyle = xlNone
        If KeyExist(sKeys, "V") Then .Borders(xlInsideVertical).LineStyle = xlNone
        If KeyExist(sKeys, "H") Then .Borders(xlInsideHorizontal).LineStyle = xlNone
      Case "T"
        .Clear
      Case Else
        Err.Raise 2001, "PuliziaRange", "Invalid Parameter " & sMode 
      End Select
      sMode = Mid$(sMode, 2)
    Loop
  End With
End Sub

'
' Cerca il carattere sKey nella stringa sKeys
' Se la string sKeys è vuota retituisce bDefault
' il confronto è case sensitive
'
' Find sKey into sKeys. If sKeys is empty return sDefault
' Search are case sensitive
'
Function KeyExist(sKeys As String, sKey As String, _
                  Optional bDefault As Boolean = True) As Boolean
  If Len(sKeys) = 0 Then
    KeyExist = bDefault
  Else
    KeyExist = (InStr(sKeys, sKey) > 0)
  End If
End Function
'
' Scompone una stringa di parametri
' Separati da virgole oppure da un altro carattere a scelta
'
'
' Parse parametre string, separated by commas or other char specified
'
Function Parse(s As String, Optional Sep) As String
Dim c As Integer
  If IsMissing(Sep) Then Sep = ","
  c = InStr(s, Sep)
  Select Case c
  Case 0
    Parse = s
    s = Empty
  Case 1
    Parse = Empty
    s = Mid$(s, 2)
  Case Else
    Parse = Mid$(s, 1, c - 1)
    s = Mid$(s, c + 1)
  End Select
End Function

'
' Cerca nella stringa S la stringa F
' Per default la ricerca è CaseSensitive (specificare vbTextCompare per NoCaseSensitive)
' Se la trova restituisce la parte di stringa S che inizia con F (F compresa)
' Se non la trova restituisce una stringa vuota
'
' Find string S into F, search are CaseSensitive (specify vbTextCompare for NoCaseSensitive)
' If found then return part of S that begins at F position (included)
' If not found then return empty string
'
Function TrimBefore(s As String, f As String, Optional vbCompare As VbCompareMethod = vbBinaryCompare) As String
Dim i As Integer
  
  i = InStr(1, s, f, vbCompare)
  If i > 0 Then
    TrimBefore = Mid$(s, i)
  Else
    TrimBefore = Empty
  End If
End Function