在VBA流程设置后，为什么不能编辑格式？

编程问答 2022-11-05

问题描述

我有一些代码可以设置工作表的格式（见下文）。

但是一旦设置了格式，用户便无法在事后更改它。

格式化是业务流程的一部分，用于标准化外观，使其准备好进行报告，但是在报告审阅过程中，审阅者可能会更改内容，做法是将单元格黄色突出显示（或将字体变为红色）。指出他们在哪里进行了更改。

由于我的代码设置了单元格颜色和字体颜色，因此它们现在似乎无法执行任何操作。

在代码执行后，如何使此内容再次可编辑的任何想法？

谢谢

Sub FormatCCO()

'Turn off pop-up alerts which are caused by having moved many WIP sheets over with the same dropdown list names
    Application.displayAlerts = False

'Turn off screen updating for smoother look and feel
    Application.ScreenUpdating = False
    
'Delete the sheet "CCO Formatted" if it exists
    On Error Resume Next
    ActiveWorkbook.Worksheets("CCO Formatted").Delete
    On Error GoTo 0

'Create a copy of the Combined sheet and rename it CCO Formatted,placing it in 2nd tab position
    Sheets("Combined").Select
    Sheets("Combined").copy Before:=Sheets(2)
    Sheets("Combined (2)").Select
    Sheets("Combined (2)").Name = "CCO Formatted"

'Delete all columns not required for CCO reporting (including last rows with the Peoplesoft Tiers
    Sheets("CCO Formatted").Range("A:A,F:F,O:O,P:P,S:U,W:Y,AC:AC,AH:AJ,AL:AT,AY:BF").EntireColumn.Delete

'Move status to Column E (after Allegation but before Date Opened)
    Columns("i:i").Select
    Selection.Cut
    Columns("e:e").Select
    Selection.Insert Shift:=xlToRight

'Format rows 2:350 - remove cell colouring,turn text to verdana 9pt black
    Rows("2:350").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.font
        .Name = "Verdana"
        .Size = 9
        .bold = False
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With

' Centre (horizontally and vertically) all colummns,then only left align Allegation (c),Key Factors (i) Investigation status (j). Autofit height
Range("a:aa").HorizontalAlignment = xlCenter
Range("a:aa").VerticalAlignment = xlCenter
Rows("2:350").AutoFit
Range("C:C,I:I,J:J").HorizontalAlignment = xlLeft


'Re-bold header row and Days Open column
    Rows("1:1").Select
    Selection.font.bold = True
    Columns("H:H").Select
    Selection.font.bold = True

'Sort by [Date Opened]
    If Not ActiveSheet.AutoFilterMode Then
        ActiveSheet.Range("A1").AutoFilter
    End If
    
    ActiveWorkbook.Worksheets("CCO Formatted").AutoFilter.sort.sortFields.Clear
    ActiveWorkbook.Worksheets("CCO Formatted").AutoFilter.sort.sortFields.Add Key _
        :=Range("f1:f350"),SortOn:=xlSortOnValues,Order:=xlAscending,DataOption _
        :=xlSortnormal
    With ActiveWorkbook.Worksheets("CCO Formatted").AutoFilter.sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .sortMethod = xlPinYin
        .Apply
    End With
    
'Apply conditional formatting to [Raised Profile] Cases
    Range("A2:G350,I2:AA350").Select
    Selection.FormatConditions.Add Type:=xlExpression,Formula1:= _
        "=$r2=""Yes"""
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = RGB(255,220,185)
    End With
     With Selection.FormatConditions(1).font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With

    Selection.FormatConditions(1).StopIfTrue = False

'Apply conditional formatting to cases where [Status] is 'Closed'
    Range("A2:G350,Formula1:= _
        "=$E2=""CLOSED"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = RGB(153,204,255)
        .TintAndShade = 0
    End With
     With Selection.FormatConditions(1).font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With

    Selection.FormatConditions(1).StopIfTrue = False

'Break external links (from migrating from WIP backups)
Call BreakExternalLinks

' Reset borders from A1 across to the last row and column
Dim lngLstCol As Long,lngLstRow As Long

    lngLstRow = ActiveSheet.UsedRange.Rows.Count
    lngLstCol = ActiveSheet.UsedRange.Columns.Count

    For Each rngCell In Range(Range("a1"),Cells(lngLstRow,lngLstCol))
        If rngCell.Value > "" Then
            rngCell.Select 'Select cells
            With Selection.Borders
                .Linestyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
        End If
    Next

'Return cursor to cell A1
Application.GoTo Reference:=Range("a1"),Scroll:=True

Application.ScreenUpdating = True
Application.displayAlerts = True

End Sub

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

excelexcelformatting