Answers for "vba default border"

vba default border

Copy' VBA ONLY

'===============================================================================
'>> SelectedCellsBordersForceDefault
'===============================================================================
' Makes all the borders of the selected cell(s) look like the default borders
'===============================================================================
Sub SelectedCellsBordersForceDefault()

    Dim sFunct As String: sFunct = "SelectedCellsBordersForceDefault"

    Dim bDebugging As Boolean: bDebugging = True
    
    If (bDebugging = True) Then
        Debug.Print Format(DateTime.Now, "hh:mm:ss") & " INFO " & sFunct & "| " _
        & "Running.. [Cells to edit borders:" & Selection.Address & "]"
    End If
        
    '*********************************
    ' VALIDATIONS and declarations
    '*********************************
    '(DECLARATIONS)
    Dim wbInit As Workbook: Set wbInit = ActiveWorkbook
    Dim wsInit As Worksheet: Set wsInit = ActiveSheet
    Dim s_rInit As String: s_rInit = Selection.Address
    
    Dim sErrMsg As String
    
    Dim rFocus As Range
    
    Dim iLineStyle As Long 'Integer
    Dim iThemeColor As Long 'Integer
    Dim dTintAndShade As Double
    Dim iWeight As Long 'Integer
    
    Dim iNormalBorder(1) As Integer
    Dim iGreyBorder(5) As Integer
    
    On Error GoTo ErrHandling
    
    '(SETTINGS/SETUP)
    Application.ScreenUpdating = False
    
    Set rFocus = Selection
    
    iLineStyle = xlContinuous
    iThemeColor = 3
    dTintAndShade = -0.099978637
    iWeight = xlThin
    
    iNormalBorder(0) = xlDiagonalDown ' 5
    iNormalBorder(1) = xlDiagonalUp ' 6
    
    iGreyBorder(0) = xlEdgeLeft ' 7
    iGreyBorder(1) = xlEdgeTop ' 8
    iGreyBorder(2) = xlEdgeBottom ' 9
    iGreyBorder(3) = xlEdgeRight ' 10
    iGreyBorder(4) = xlInsideVertical ' 11
    iGreyBorder(5) = xlInsideHorizontal ' 12
    
    '---------------------------------
    '               WORK
    '---------------------------------
    '1) Do the general work
    
    'Z) Reactivate the initial workbook/worksheet
        
    '--(1)
    With rFocus
        For Each edge In iNormalBorder
            .Borders(edge).LineStyle = xlNone
        Next
        For Each edge In iGreyBorder
            With .Borders(edge)
                .LineStyle = iLineStyle
                .ThemeColor = iThemeColor
                .TintAndShade = dTintAndShade
                .Weight = iWeight
            End With
        Next
    End With
    
    '--(Z)
    wbInit.Activate
    wsInit.Activate
    Range(s_rInit).Select
    
    '-----------v-----------DEBUG INFO-----------v-----------
    
    If (bDebugging = True) Then
        Debug.Print Format(DateTime.Now, "hh:mm:ss") & " INFO " & sFunct & "| " _
        & "Complete [if not debugging, make bDebugging = false]"
    End If
    
    Application.ScreenUpdating = True
            
    Exit Sub
            
ErrHandling:
    
    Application.ScreenUpdating = True
    
    Debug.Print Format(DateTime.Now, "hh:mm:ss") & " INFO " & sFunct & "| " _
        & " -> Failed"
    
    MsgBox _
        Title:="Errors in the function: " & sFunct _
        , Prompt:=Err.Description _
        & vbNewLine & sErrMsg _
        , Buttons:=vbCritical
        
End Sub