Страницы: 1
RSS
Поздравительные видео с НГ, в таблицах
 


Вот несколько видео по нашей теме
https://cs18.pikabu.ru/s/2025/12/12/14/xmfrcwlj_s0f0d12m0_464x848.mp4
https://cs20.pikabu.ru/s/2025/12/12/20/bhh2xquk_s0f0d10m0_640x382.mp4
https://cs19.pikabu.ru/s/2025/12/14/07/rejuwpd4_s0f0d82m0_1728x1080.mp4
https://cs16.pikabu.ru/s/2025/12/12/18/vnqsj5vd_s0f0d6m0_1440x1440.mp4
https://cs18.pikabu.ru/s/2025/12/12/23/imprchb3_s0f0d28m0_1920x1032.mp4

Вот код пятого видео https://pastebin.com/cbD4eLXG
Код
Sub HappyNewYear()

    Columns("A:AA").Select

    Selection.ColumnWidth = 2

    Rows("1:38").Select

    Selection.RowHeight = 40

    Range( _

        "M1,L2:N2,K3:O3,J4:P4,I5:Q5,H6:R6,G7:S7,F8:T8,E9:U9,D10:V10,C11:W11,B12:X12"). _

        Select

    Application.Wait (Now + 0.000007)

    Range("B12").Activate

    Application.Wait (Now + 0.000007)

    With Selection.Interior

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

        .ThemeColor = xlThemeColorAccent6

        .TintAndShade = -0.249977111117893

        .PatternTintAndShade = 0

    End With

    Application.Wait (Now + 0.000007)

    Range("M1").Select

    Application.Wait (Now + 0.000007)

    ActiveCell.FormulaR1C1 = "=RANDBETWEEN(1,10)"

    Range("M1").Select

    Selection.Copy

    Application.CutCopyMode = False

    Selection.Copy

    Application.Wait (Now + 0.000007)

    Range( _

        "L2,M2,N2,K3:O3,J4:P4,I5:Q5,H6:R6,G7:S7,F8:T8,E9:U9,D10:V10,C11:W11,B12:X12"). _

        Select

    Range("B12").Activate

    Application.Wait (Now + 0.000007)

    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

        False, Transpose:=False

    Range( _

        "L2,M2,N2,K3:O3,J4:P4,I5:Q5,H6:R6,G7:S7,F8:T8,E9:U9,D10:V10,C11:W11,B12:X12,M1" _

        ).Select

    Range("M1").Activate

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    Application.Wait (Now + 0.000007)

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    Selection.FormatConditions.AddIconSetCondition

    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

    Application.Wait (Now + 0.000007)

    With Selection.FormatConditions(1)

        .ReverseOrder = False

        .ShowIconOnly = False

        .IconSet = ActiveWorkbook.IconSets(xl3TrafficLights1)

    End With

    With Selection.FormatConditions(1).IconCriteria(2)

        .Type = xlConditionValuePercent

        .Value = 33

        .Operator = 7

    End With

    With Selection.FormatConditions(1).IconCriteria(3)

        .Type = xlConditionValuePercent

        .Value = 67

        .Operator = 7

    End With

    Application.ScreenUpdating = False

        Columns("AA:AA").Select

    Selection.ColumnWidth = 255

    Range("AD4").Select

    ActiveWindow.SmallScroll Down:=-12

 
    Columns("AB:CB").Select

    Selection.ColumnWidth = 2

    Union(Range( _

        "AX3:AX6,AX2,AU2:BA2,BE2:BE6,BF4:BH4,BI4,BJ5,BF6:BI6,BL2:BL6,AI12,AI11,AI10,AI9,AI8,AJ8,AK8,AL8,AM8,AN8:AN12,AR8:AR12,AS12,AT11,AU10,AV9,AW8,AX8:AX12,BA12,BB11:BG11,BH12,BC8:BC10,BD8:BF8,BF9:BF10" _

        ), Range( _

        "BK9:BK11,BL12,BM12:BO12,BP9:BP11,BL8:BO8,BT8:BT12,BU8:BX8,BY9,BU10:BX10")). _

        Select

    Range("BL2").Activate

    With Selection.Interior

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

        .ThemeColor = xlThemeColorAccent6

        .TintAndShade = -0.249977111117893

        .PatternTintAndShade = 0

    End With

    Range("AU2").Select

    ActiveCell.FormulaR1C1 = "=RANDBETWEEN(1,10)"

    Range("AU2").Select

    Selection.Copy

    Union(Range( _

        "BV8,BU8,AV2:BA2,AX3:AX6,BE2:BE6,BF6:BI6,BJ5,BF4:BI4,BL2:BL6,AI8:AI12,AN8:AN12,AJ8:AM8,AR8:AR12,AS12,AT11,AU10,AV9,AW8,AX8:AX12,BA12,BH12,BB11:BG11,BC8:BC10,BD8:BF8,BF9:BF10,BK9:BK11,BL12:BO12,BP9:BP11,BL8:BO8,BT8:BT12,BU10:BX10,BY9" _

        ), Range("BX8,BW8")).Select

    Range("BU8").Activate

    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

        False, Transpose:=False

    Application.CutCopyMode = False

    With Selection

        .HorizontalAlignment = xlGeneral

        .VerticalAlignment = xlCenter

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    Union(Range( _

        "BV8,BU8,AU2,AV2:BA2,AX3:AX6,BE2:BE6,BF6:BI6,BJ5,BF4:BI4,BL2:BL6,AI8:AI12,AN8:AN12,AJ8:AM8,AR8:AR12,AS12,AT11,AU10,AV9,AW8,AX8:AX12,BA12,BH12,BB11:BG11,BC8:BC10,BD8:BF8,BF9:BF10,BK9:BK11,BL12:BO12,BP9:BP11,BL8:BO8,BT8:BT12,BU10:BX10" _

        ), Range("BY9,BX8,BW8")).Select

    Range("AU2").Activate

    With Selection

        .VerticalAlignment = xlCenter

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    Application.Wait (Now + 0.000006)

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    Selection.FormatConditions.AddIconSetCondition

    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

    With Selection.FormatConditions(1)

        .ReverseOrder = False

        .ShowIconOnly = False

        .IconSet = ActiveWorkbook.IconSets(xl3TrafficLights2)

    End With

    With Selection.FormatConditions(1).IconCriteria(2)

        .Type = xlConditionValuePercent

        .Value = 33

        .Operator = 7

    End With

    With Selection.FormatConditions(1).IconCriteria(3)

        .Type = xlConditionValuePercent

        .Value = 67

        .Operator = 7

    End With

    Range("A1").Select

    Application.ScreenUpdating = True

    Dim i As Integer

    For i = 1 To 300

        If Columns("AA").ColumnWidth > 2 Then

            Columns("AA").ColumnWidth = Columns("AA").ColumnWidth - 1

            If Columns("AA").ColumnWidth = 2 Then

                Application.ScreenUpdating = False

                Application.ScreenUpdating = True

            End If

        End If

        Application.CalculateFullRebuild

        Application.Wait (Now + 0.000005)

    Next i

End Sub
.
 
Ещё немного новогодних открыток
"Новый год к нам мчится..."
 
.
Страницы: 1
Читают тему
Наверх