Макроси, що дозволяють автоматизувати дії працівників служби маркетингу по створенню продуктових стратегій підприємства:

Private Sub Workbook_Open()

UserForm2.Show

End Sub

 

Sub main()

UserForm1.Show

End Sub

Sub СТ()

'

' СТ Макрос

''

 Sheets("1").Select

 Range("A1:G2").Select

 Selection.Copy

 Sheets("2").Select

 Range("A1").Select

 ActiveSheet.Paste

 Sheets("1").Select

 Range("A3:A8").Select

 Application.CutCopyMode = False

 Selection.Copy

 Sheets("2").Select

 Range("A3").Select

 Sheets("2").Select

 ActiveSheet.Paste

 Sheets("1").Select

 Range("B3:B8").Select

 Application.CutCopyMode = False

 Selection.Copy

 Sheets("2").Select

 Range("B3").Select

 ActiveSheet.Paste

 Range("C3:G8").Select

 Application.CutCopyMode = False

 Selection.Borders(xlDiagonalDown).LineStyle = xlNone

 Selection.Borders(xlDiagonalUp).LineStyle = xlNone

 With Selection.Borders(xlEdgeLeft)

 .LineStyle = xlContinuous

 .Weight = xlThin

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeTop)

 .LineStyle = xlContinuous

 .Weight = xlThin

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeBottom)

 .LineStyle = xlContinuous

 .Weight = xlThin

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeRight)

 .LineStyle = xlContinuous

 .Weight = xlThin

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlInsideVertical)

 .LineStyle = xlContinuous

 .Weight = xlThin

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlInsideHorizontal)

 .LineStyle = xlContinuous

 .Weight = xlThin

 .ColorIndex = xlAutomatic

 End With

 Range("A1:A2").Select

 With Selection

 .HorizontalAlignment = xlCenter

 .WrapText = False

 .Orientation = 0

 .AddIndent = False

 .IndentLevel = 0

 .ShrinkToFit = False

 .ReadingOrder = xlContext

 .MergeCells = False

 End With

 Selection.Merge

 ActiveCell.FormulaR1C1 = "№"

 Range("B1:B2").Select

 With Selection

 .HorizontalAlignment = xlCenter

 .VerticalAlignment = xlCenter

 .WrapText = False

 .Orientation = 0

 .AddIndent = False

 .IndentLevel = 0

 .ShrinkToFit = False

 .ReadingOrder = xlContext

 .MergeCells = False

 End With

 Selection.Merge

 Range("A8:B8").Select

 Selection.Borders(xlDiagonalDown).LineStyle = xlNone

 Selection.Borders(xlDiagonalUp).LineStyle = xlNone

 With Selection.Borders(xlEdgeLeft)

 .LineStyle = xlContinuous

 .Weight = xlThin

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeTop)

 .LineStyle = xlContinuous

 .Weight = xlThin

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeBottom)

 .LineStyle = xlContinuous

 .Weight = xlThin

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeRight)

 .LineStyle = xlContinuous

 .Weight = xlThin

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlInsideVertical)

 .LineStyle = xlContinuous

 .Weight = xlThin

 .ColorIndex = xlAutomatic

 End With

 Range("B14").Select

 ActiveWindow.SmallScroll Down:=-9

End Sub

Sub Форматирование()

'

' Форматирование Макрос

' Макрос записан 10.06.2008 (Managers)

''

 Columns("B:B").Select

 Selection.ColumnWidth = 30

 Rows("1:8").Select

 Range("C1").Activate

 Rows("1:8").EntireRow.AutoFit

 Range("A1:G8").Select

 Selection.Borders(xlDiagonalDown).LineStyle = xlNone

 Selection.Borders(xlDiagonalUp).LineStyle = xlNone

 With Selection.Borders(xlEdgeLeft)

 .LineStyle = xlContinuous

 .Weight = xlThick

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeTop)

 .LineStyle = xlContinuous

 .Weight = xlThick

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeBottom)

 .LineStyle = xlContinuous

 .Weight = xlThick

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeRight)

 .LineStyle = xlContinuous

 .Weight = xlThick

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlInsideVertical)

 .LineStyle = xlContinuous

 .Weight = xlThin

 .ColorIndex = xlAutomatic

 End With

 Range("A1:G2").Select

 Selection.Borders(xlDiagonalDown).LineStyle = xlNone

 Selection.Borders(xlDiagonalUp).LineStyle = xlNone

 With Selection.Borders(xlEdgeLeft)

 .LineStyle = xlContinuous

 .Weight = xlThick

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeTop)

 .LineStyle = xlContinuous

 .Weight = xlThick

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeBottom)

 .LineStyle = xlContinuous

 .Weight = xlMedium

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeRight)

 .LineStyle = xlContinuous

 .Weight = xlThick

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlInsideVertical)

 .LineStyle = xlContinuous

 .Weight = xlMedium

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlInsideHorizontal)

 .LineStyle = xlContinuous

 .Weight = xlMedium

 .ColorIndex = xlAutomatic

 End With

 Range("F1:F8").Select

 Selection.Borders(xlDiagonalDown).LineStyle = xlNone

 Selection.Borders(xlDiagonalUp).LineStyle = xlNone

 With Selection.Borders(xlEdgeLeft)

 .LineStyle = xlContinuous

 .Weight = xlMedium

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeTop)

 .LineStyle = xlContinuous

 .Weight = xlThick

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeBottom)

 .LineStyle = xlContinuous

 .Weight = xlThick

 .ColorIndex = xlAutomatic

 End With

 Range("A3:A8").Select

 Selection.Font.ColorIndex = 1

 Selection.Font.ColorIndex = 6

 With Selection.Interior

 .ColorIndex = 1

 .Pattern = xlSolid

 End With

 Selection.Font.Bold = True

 With Selection.Font

 .Name = "Arial"

 .Size = 12

 .Strikethrough = False

 .Superscript = False

 .Subscript = False

 .OutlineFont = False

 .Shadow = False

 .Underline = xlUnderlineStyleNone

 .ColorIndex = 6

 End With

 With Selection.Font

 .Name = "Bookman Old Style"

 .Size = 12

 .Strikethrough = False

 .Superscript = False

 .Subscript = False

 .OutlineFont = False

 .Shadow = False

 .Underline = xlUnderlineStyleNone

 .ColorIndex = 6

 End With

 Range("A1:G2").Select

 With Selection.Interior

 .ColorIndex = 6

 .Pattern = xlSolid

 End With

 Selection.Font.ColorIndex = 1

 Selection.Font.Bold = True

 With Selection.Font

 .Name = "Monotype Corsiva"

 .Size = 10

 .Strikethrough = False

 .Superscript = False

 .Subscript = False

 .OutlineFont = False

 .Shadow = False

 .Underline = xlUnderlineStyleNone

 .ColorIndex = 1

 End With

 Selection.Font.Bold = False

 With Selection.Font

 .Name = "Monotype Corsiva"

 .Size = 12

 .Strikethrough = False

 .Superscript = False

 .Subscript = False

 .OutlineFont = False

 .Shadow = False

 .Underline = xlUnderlineStyleNone

 .ColorIndex = 1

 End With

 Selection.Font.Bold = True

 Selection.Font.Bold = False

 With Selection.Font

 .Name = "Monotype Corsiva"

 .Size = 14

 .Strikethrough = False

 .Superscript = False

 .Subscript = False

 .OutlineFont = False

 .Shadow = False

 .Underline = xlUnderlineStyleNone

 .ColorIndex = 1

 End With

 Range("B3:B8").Select

 With Selection.Interior

 .ColorIndex = 43

 .Pattern = xlSolid

 End With

 Range("A1:A2").Select

 With Selection

 .HorizontalAlignment = xlCenter

 .VerticalAlignment = xlCenter

 .WrapText = False

 .Orientation = 0

 .AddIndent = False

 .IndentLevel = 0

 .ShrinkToFit = False

 .ReadingOrder = xlContext

 .MergeCells = True

 End With

 Range("B14").Select

End Sub

Sub Заполнение()

'

' Заполнение Макрос

' Макрос записан 10.06.2008 (Managers)

''

 Sheets("1").Select

 Range("C3:C8").Select

 Selection.Copy

 Sheets("2").Select

 Range("C3").Select

 ActiveSheet.Paste

 Sheets("1").Select

 Range("D3:D8").Select

 Application.CutCopyMode = False

 Selection.Copy

 Sheets("2").Select

 Range("D3").Select

 ActiveSheet.Paste

 Sheets("1").Select

 Range("E3:E8").Select

 Application.CutCopyMode = False

 Selection.Copy

 Sheets("2").Select

 Range("E3").Select

 ActiveSheet.Paste

 Range("A1:G2").Select

 Selection.Font.ColorIndex = 5

 Range("F11").Select

 Sheets("2").Select

 ActiveWorkbook.Sheets("2").Tab.ColorIndex = 3

 Sheets("1").Select

 ActiveWorkbook.Sheets("1").Tab.ColorIndex = 44

 Sheets("3").Select

 ActiveWorkbook.Sheets("3").Tab.ColorIndex = 6

 Range("D41").Select

 Sheets("2").Select

End Sub

Sub Рассчет()

'

' Рассчет Макрос

'

 

'

 Range("F3").Select

 ActiveCell.FormulaR1C1 = "=RC[-1]/RC[-3]"

 Range("F3").Select

 ActiveCell.FormulaR1C1 = "=(RC[-1]/RC[-3])*100"

 Range("F3").Select

 Selection.NumberFormat = "#,##0.00"

 Selection.AutoFill Destination:=Range("F3:F8"), Type:=xlFillDefault

 Range("F3:F8").Select

 With Selection

 .HorizontalAlignment = xlCenter

 .VerticalAlignment = xlBottom

 .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

 Range("F8").Select

 Selection.Borders(xlDiagonalDown).LineStyle = xlNone

 Selection.Borders(xlDiagonalUp).LineStyle = xlNone

 With Selection.Borders(xlEdgeLeft)

 .LineStyle = xlContinuous

 .Weight = xlMedium

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeTop)

 .LineStyle = xlContinuous

 .Weight = xlThin

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeBottom)

 .LineStyle = xlContinuous

 .Weight = xlMedium

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeRight)

 .LineStyle = xlContinuous

 .Weight = xlThin

 .ColorIndex = xlAutomatic

 End With

 Range("G3").Select

 ActiveCell.FormulaR1C1 = "=(RC[-2]/RC[-3])*100"

 Range("F3").Select

 Selection.Copy

 Range("G3").Select

 Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _

 SkipBlanks:=False, Transpose:=False

 Application.CutCopyMode = False

 Selection.AutoFill Destination:=Range("G3:G8"), Type:=xlFillDefault

 Range("G3:G8").Select

 Range("G3:G8").Select

 Selection.Borders(xlDiagonalDown).LineStyle = xlNone

 Selection.Borders(xlDiagonalUp).LineStyle = xlNone

 With Selection.Borders(xlEdgeLeft)

 .LineStyle = xlContinuous

 .Weight = xlThin

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeTop)

 .LineStyle = xlContinuous

 .Weight = xlMedium

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeBottom)

 .LineStyle = xlContinuous

 .Weight = xlThin

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeRight)

 .LineStyle = xlContinuous

 .Weight = xlMedium

 .ColorIndex = xlAutomatic

 End With

 Range("G8").Select

 Selection.Borders(xlDiagonalDown).LineStyle = xlNone

 Selection.Borders(xlDiagonalUp).LineStyle = xlNone

 With Selection.Borders(xlEdgeLeft)

 .LineStyle = xlContinuous

 .Weight = xlThin

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeTop)

 .LineStyle = xlContinuous

 .Weight = xlThin

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeBottom)

 .LineStyle = xlContinuous

 .Weight = xlMedium

 .ColorIndex = xlAutomatic

 End With

 With Selection.Borders(xlEdgeRight)

 .LineStyle = xlContinuous

 .Weight = xlMedium

 .ColorIndex = xlAutomatic

 End With

 Range("F17").Select

End Sub

Sub Очистка()

'

' Очистка Макрос

' Макрос записан 10.06.2008 (Managers)

''

 Range("A1:H9").Select

 Selection.Clear

 Columns("B:B").ColumnWidth = 10.14

 Columns("F:F").ColumnWidth = 9

 Columns("G:G").ColumnWidth = 10.57

 Columns("A:A").ColumnWidth = 9.57

 Range("H19").Select

End Sub