sztm-excel/src/macros/SZTM_Spielliste.bas

Attribute VB_Name = "Module2"
Sub SZTM_Spielliste()
Attribute SZTM_Spielliste.VB_Description = "Formatiert die Spielliste"
Attribute SZTM_Spielliste.VB_ProcData.VB_Invoke_Func = "X\n14"
'
' SZTM_Spielliste Macro
' Formatiert die Spielliste
'
' Keyboard Shortcut: Ctrl+Shift+X
'


    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Sheets
        With ws
        
            ws.Activate
            
            'Select first row, change font size, make bold and merge
            Range("A1:K1").Select
            With Selection
                .HorizontalAlignment = xlLeft
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = True
            End With
            Selection.Merge
            With Selection.Font
                .Name = "Calibri"
                .Size = 14
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ThemeColor = xlThemeColorLight1
                .TintAndShade = 0
                .ThemeFont = xlThemeFontMinor
            End With
            Selection.Font.Bold = True
            
            'Select second row, make bold and merge
            Range("A2:K2").Select
            With Selection
                .HorizontalAlignment = xlLeft
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = True
            End With
            Selection.Merge
            Selection.Font.Bold = True
                        
            'Select all data cells, activate grid, fit width, increase height and add header.
            Range("A4:K4").Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = -0.149998474074526
                .PatternTintAndShade = 0
            End With
            Selection.Font.Bold = True
            ActiveWindow.SmallScroll Down:=-3
            Range("A4").Select
            Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            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
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            Selection.RowHeight = 33.75
            Selection.EntireColumn.AutoFit
            'Columns("A:A").EntireColumn.AutoFit
            'Columns("B:B").EntireColumn.AutoFit
            'Columns("C:C").EntireColumn.AutoFit
            'Columns("D:D").EntireColumn.AutoFit
            'Columns("E:E").EntireColumn.AutoFit
            
        End With
    Next

End Sub