什么是 vba 代码来更改从 6 开始的多个 excel 工作表中第一行的颜色？

Question

我需要格式化（创建标题，select 供应商代码根据 table...）每个 sheet 开头的一组单元格来自 sheet 6. 我已经有了 VBA 代码来插入 table 上面的行，现在我只需要代码同时格式化来自 sheet 6 的单元格。谁能帮我？我的插行代码如下：

Sub insert_rows()

Application.DisplayAlerts = False


Dim i As Integer, a As Integer

a = 6

For i = Sheets.Count To 6 Step -1

If Sheets.Count = 6 Then
Exit Sub
End If

a = a + 1

    Sheets(i).Range("1:1").Insert
    Sheets(i).Range("2:2").Insert
    Sheets(i).Range("3:3").Insert
    Sheets(i).Range("4:4").Insert
    Sheets(i).Range("5:5").Insert
    Sheets(i).Range("6:6").Insert
    Sheets(i).Range("7:7").Insert
    Sheets(i).Range("8:8").Insert
    
Application.DisplayAlerts = True
Next

End Sub

我要的格式如下。我需要从 sheet 6 开始应用此格式的代码，因为第一个 sheets 支持 tables 的 sheets，因此不需要这个“header”。子格式() ' ' 格式宏

Range("B1:J2").Select
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
Selection.Merge
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = True
End With
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.249977111117893
    .PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("B1:J2").Select
With Selection.Font
    .Color = -10066432
    .TintAndShade = 0
End With
Range("B1:J2").Select
ActiveCell.FormulaR1C1 = "TITLE"
Range("B4").Select
ActiveCell.FormulaR1C1 = "Name:"
Range("B5").Select
ActiveCell.FormulaR1C1 = "Code:"
Range("B6").Select
ActiveCell.FormulaR1C1 = "Date:"
Range("C4").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("C5").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("C6").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveWindow.DisplayGridlines = False

结束子

谢谢！

Answer 1

如何尽可能摆脱 Select/Activate

Option Explicit


Sub CreateHeadersAfterSheet5()
    Const ProcName As String = "CreateHeadersAfterSheet5"
    On Error GoTo ClearError
    
    Const FirstWorksheetIndex As Long = 6
    
    Application.ScreenUpdating = False
    
    With ThisWorkbook
        
        Dim LastWorksheetIndex As Long: LastWorksheetIndex = .Worksheets.Count
        If LastWorksheetIndex < FirstWorksheetIndex Then Exit Sub
        
        Dim ash As Object: Set ash = .ActiveSheet
        
        Dim n As Long
        
        For n = FirstWorksheetIndex To LastWorksheetIndex
            CreateHeaders .Worksheets(n)
        Next n
    
        ash.Select
    
    End With
    
    Application.ScreenUpdating = True
    
    MsgBox "Headers created."

ProcExit:
    Exit Sub
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Sub


Sub CreateHeaders(ByVal ws As Worksheet)
    Const ProcName As String = "CreateHeaders"
    On Error GoTo ClearError
    
    With ws
        
        .Select ' cannot be avoided only because of the following line
        ActiveWindow.DisplayGridlines = False
    
        .Range("1:8").Insert
        
        With .Range("B1:J2")
            .Merge
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            '.MergeCells = True
            With .Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = -0.249977111117893
                .PatternTintAndShade = 0
            End With
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Borders(xlEdgeLeft).LineStyle = xlNone
            .Borders(xlEdgeTop).LineStyle = xlNone
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            .Borders(xlEdgeRight).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
            With .Font
                .Color = -10066432
                .TintAndShade = 0
            End With
        End With
        
        .Range("B1").Value = "TITLE"
        
        .Range("B4").Value = "Name:"
        
        .Range("B5").Value = "Code:"
        
        .Range("B6").Value = "Date:"
        
        With .Range("C4")
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Borders(xlEdgeLeft).LineStyle = xlNone
            .Borders(xlEdgeTop).LineStyle = xlNone
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            .Borders(xlEdgeRight).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
        
        With .Range("C5")
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Borders(xlEdgeLeft).LineStyle = xlNone
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            .Borders(xlEdgeRight).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
        
        With .Range("C6")
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Borders(xlEdgeLeft).LineStyle = xlNone
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            .Borders(xlEdgeRight).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
        
    End With

ProcExit:
    Exit Sub
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Sub

什么是 vba 代码来更改从 6 开始的多个 excel 工作表中第一行的颜色？

What's the vba code to change the color of the first line in multiple excel sheets from 6 onwards?

format

excel

formatting

vba

如何尽可能摆脱 Select/Activate