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

[A1].Characters.Text(Start, Length)
[A1].Characters(Start, Length).Caption

Sub Tester()
    With ActiveSheet
        AddValue .Range("A1"), "Hello", vbRed
        AddValue .Range("A1"), "Hello", vbGreen
        AddValue .Range("A1"), "Hello", vbBlue
    End With
End Sub
Sub AddValue(rngVal As Range, val, theColor As Long)
    Const SEP As String = " "
    Dim firstChar As Long, extra As Long
    firstChar = 1 + Len(rngVal.Value)
    extra = IIf(firstChar = 1, 0, 1)
    With rngVal
        .Characters(firstChar).Text = IIf(Len(rngVal.Value) > 0, SEP, "") & val
        .Characters(firstChar + extra, Len(val)).Font.Color = theColor
    End With
End Sub

Sub RunConcat()
  ConcatenatewithFormat Selection, ThisWorkbook.ActiveSheet.Cells(Selection.Row, Selection.Column + Selection.Columns.Count)
End Sub
Sub ConcatenateWithFormat(InputRange As Range, OutPutRange As Range)
Dim i As Integer, q As Variant
Dim sText As String, c As String, A As Variant
Dim oChars As Characters, n As Integer
  OutPutRange.Clear: n = 0
  For Each A In InputRange
    sText = A.Text
    For i = 1 To Len(sText)
      Set oChars = A.Characters(i, 1)
      Set q = OutPutRange.Characters(i + n, 1)
      q.Caption = oChars.Caption
      With oChars
        q.Font.Bold = .Font.Bold
        q.Font.Name = .Font.Name
        'q.Font.Color = .Font.Color
        q.Font.ColorIndex = .Font.ColorIndex
        q.Font.FontStyle = .Font.FontStyle
        q.Font.OutlineFont = .Font.OutlineFont
        q.Font.Size = .Font.Size
        q.Font.Strikethrough = .Font.Strikethrough
        q.Font.Subscript = .Font.Subscript
        q.Font.Superscript = .Font.Superscript
        q.Font.Underline = .Font.Underline
      End With
    Next i
    n = n + Len(sText)
  Next A
End Sub

Sub TabTest()
If i = 1 Then
j = 2
End If
End Sub

Sub TabTest()
    If i = 1 Then
        j = 2
    End If
End Sub

WindowsFormsExtensions.SetTaskbarProgress(this, 35);
this.SetTaskbarProgressState(Windows7Taskbar.ThumbnailProgressState.Normal);

for i=1 to 100
Application.Progress(i)
next i

SetForegroundWindow w.hwnd
ShowWindow w.hwnd, 5
retval = SendMessage(w.hwnd, WM_SETFOCUS, 0, 0)

Const VK_H = 72, VK_E = 69, VK_L = 76, VK_O = 79, KEYEVENTF_KEYUP = &H2, INPUT_MOUSE = 0, INPUT_KEYBOARD = 1, INPUT_HARDWARE = 2
Type MOUSEINPUT: dx As Long: dy As Long: mouseData As Long: dwFlags As Long: time As Long: dwExtraInfo As Long: End Type
Type KEYBDINPUT: wVk As Integer: wScan As Integer: dwFlags As Long: time As Long: dwExtraInfo As Long: End Type
Type HARDWAREINPUT: uMsg As Long: wParamL As Integer: wParamH As Integer: End Type
Type GENERALINPUT: dwType As Long: xi(0 To 23) As Byte: End Type
Declare PtrSafe Function SendInput Lib "user32.dll" (ByVal nInputs As Long, pInputs As GENERALINPUT, ByVal cbSize As Long) As Long
Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Sub go1()
AppActivate "Блокнот"
SendKey VK_H: SendKey VK_E: SendKey VK_L: SendKey VK_L: SendKey VK_O
End Sub
Sub SendKey(bKey As Byte)
Dim GInput(0 To 1) As GENERALINPUT
Dim KInput As KEYBDINPUT
KInput.wVk = bKey
KInput.dwFlags = 0
GInput(0).dwType = INPUT_KEYBOARD
CopyMemory GInput(0).xi(0), KInput, Len(KInput)
KInput.wVk = bKey
KInput.dwFlags = KEYEVENTF_KEYUP
GInput(1).dwType = INPUT_KEYBOARD
CopyMemory GInput(1).xi(0), KInput, Len(KInput)
Call SendInput(2, GInput(0), Len(GInput(0)))
End Sub

set obj = Nothing
max-age=0
no-cache, no-store, must-revalidate
"If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
?hash=rnd

asd1qwd1er345568678345111

Sub auto_open()
Application.OnKey "^{TAB}", "Переход1" 'Ctrl+TAB 'следующий лист
Application.OnKey "^+{TAB}", "Переход2" 'Ctrl+Shift+TAB 'прошлый лист
End Sub

Sub Переход1()
Application.ScreenUpdating = False
On Error Resume Next
Application.OnKey "^{TAB}", ActiveSheet.Next.Select 'Ctrl+TAB 'следующий лист
Application.ScreenUpdating = True
End Sub

Sub Переход2()
Application.ScreenUpdating = False
On Error Resume Next
Application.OnKey "^+{TAB}", ActiveSheet.Previous.Select 'Ctrl+Shift+TAB 'прошлый лист
Application.ScreenUpdating = True
End Sub

Sub test1()
[A1:A10].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[D1], Unique:=True
End Sub

Sub test2()
[D1:D10].ClearContents
[A1:A10].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[D1], Unique:=True
[D1] = "111"
[A1:A10].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[D1], Unique:=True
End Sub

Erase a 'массив
Set a = Nothing 'object, range
a = VbNullString '$
a = "" '$
a = Empty '&
a = 0 '&

Sub test()
Set t1 = Union([a1:c1], [a3:d4])
t2 = t1.Rows.Count
t1.Select
End Sub

AVDoc.GetAVPageView.ZoomTo 1, 1
doc.zoomtype = jso.zoomtype.fitP
Exch.MenuItemExecute ("FitPage")
doc.app.execMenuItem ("FitPage")

jso.getField("Name").Value = "text"