Объектно-ориентированное программирование на VBA в среде Excel (стр. 3 из 3)
4. «Макрос1»
Sub Макрос1()
' Макрос1 Макрос
' Макросзаписан 25.11.2008 (User)
Range("A1:H1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Range("A1:H1").Select
ActiveCell.FormulaR1C1 = _
"Список товаров, подготовленных к продаже. Охидаемаявыручка"
Range("A3:H3").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A3").Select
ActiveCell.FormulaR1C1 = "Номенк. Номер"
With ActiveCell.Characters(Start:=1, Length:=13).Font
.Name = "Arial Cyr"
.FontStyle = "обычный"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("B3").Select
ActiveCell.FormulaR1C1 = "Наименов. Товара"
With ActiveCell.Characters(Start:=1, Length:=16).Font
.Name = "Arial Cyr"
.FontStyle = "обычный"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("C3").Select
ActiveCell.FormulaR1C1 = "Еден. Изм."
With ActiveCell.Characters(Start:=1, Length:=10).Font
.Name = "Arial Cyr"
.FontStyle = "обычный"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("D3").Select
ActiveCell.FormulaR1C1 = "Ценазаед.,руб."
With ActiveCell.Characters(Start:=1, Length:=16).Font
.Name = "Arial Cyr"
.FontStyle = "обычный"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("E3").Select
ActiveCell.FormulaR1C1 = "Кол-во"
With ActiveCell.Characters(Start:=1, Length:=6).Font
.Name = "Arial Cyr"
.FontStyle = "обычный"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("F3").Select
ActiveCell.FormulaR1C1 = "Сумма, руб."
With ActiveCell.Characters(Start:=1, Length:=11).Font
.Name = "Arial Cyr"
.FontStyle = "обычный"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("G3").Select
ActiveCell.FormulaR1C1 = "Налог (20%)"
With ActiveCell.Characters(Start:=1, Length:=10).Font
.Name = "Arial Cyr"
.FontStyle = "обычный"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("H3").Select
ActiveCell.FormulaR1C1 = "Всего, руб."
With ActiveCell.Characters(Start:=1, Length:=11).Font
.Name = "Arial Cyr"
.FontStyle = "обычный"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("A3:H3").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 = xlMedium
.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
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
Columns("B:B").ColumnWidth = 10.43
End Sub
Sub Кнопка1_Щелкнуть()
Load UserForm1
UserForm1.Show
End Sub
5. Кнопка «Шапкатаблицы»
Private Sub CommandButton1_Click()
Call Макрос1
End Sub
6. Кнопка «Вводисходныхданных»
Private Sub CommandButton2_Click()
Load UserForm2
UserForm2.Show
End Sub
7. Кнопка «Расчет»
Private Sub CommandButton3_Click()
Dim N, I As Integer
N = 0
Do While Cells(4 + N, 1) <> ""
N = N + 1
A = Cells(3 + N, 4)
B = Cells(3 + N, 5)
C = A * B
Cells(N + 3, 6) = Str(C)
D = C * 0.2
Cells(N + 3, 7) = Str(D)
F = C + D
Cells(N + 3, 8) = Str(F)
Loop
End Sub
8. Кнопка «Добавить»
Private Sub CommandButton4_Click()
Dim I, N, J As Integer
Dim A, B, C As String
Dim F As Single
Dim D As Single
I = 0
Do While Cells(I + 3, 1) <> ""
I = I + 1
Loop
Range(Cells(I + 3, 1), Cells(I + 3, 8)).Clear
J = InputBox("Введите номер строки добавляемой записи")
N = J + 1
Do While I < N
A = InputBox("Номенклатурный номер")
B = InputBox("Наименование товара")
C = InputBox("Еденица измерения")
D = Val(InputBox("Цена за еденицу"))
F = Val(InputBox("Количество"))
Cells(3 + I, 1).Value = A
Cells(3 + I, 2).Value = B
Cells(3 + I, 3).Value = C
Cells(3 + I, 4).Value = D
Cells(3 + I, 5).Value = F
I = I + 1
Loop
End Sub
9. Кнопка «Очистить»
Private Sub CommandButton5_Click()
Dim I, N As Integer
N = 0
Do While Cells(3 + N, 7) <> ""
N = N + 1
Loop
For I = 1 To N
Cells(I + 3, 1).Clear
Cells(I + 3, 2).Clear
Cells(I + 3, 3).Clear
Cells(I + 3, 4).Clear
Cells(I + 3, 5).Clear
Cells(I + 3, 6).Clear
Cells(I + 3, 7).Clear
Cells(I + 3, 8).Clear
Next I
End Sub
10. Кнопка «Итого»
Private Sub CommandButton6_Click()
Dim N%
Dim I%
Dim SG!
Dim G!(20)
N = 0
Do While Cells(N + 4, 7) <> ""
N = N + 1
Loop
For I = 1 To N
G(I) = Cells(I + 3, 8).Value
Next I
SG = 0
For I = 1 To N
SG = SG + G(I)
Next I
Cells(N + 4, 7).Value = "Итого"
Cells(N + 4, 8).Value = SG
11. Кнопка «Выход»
Private Sub CommandButton7_Click()
End
End Sub
Итоговая таблица:
| Номенк. Номер | Наименов. Товара | Еден. Изм. | Цена за ед.,руб. | Кол-во | Сумма, руб. | Налог (20%) | Всего, руб. |
| 13675 | Шапки | шт. | 788,00 | 64 | 50432,00 | 10086,40 | 60518,40 |
| 3816 | Пальто | шт. | 1435,80 | 42 | 60303,60 | 12060,72 | 72364,32 |
| 13855 | Платки | шт. | 194,35 | 86 | 16714,10 | 3342,82 | 20056,92 |
| 3843 | Рубашки | шт. | 220,75 | 110 | 24282,50 | 4856,50 | 29139,00 |
| 3811 | Куртки | шт. | 984,40 | 38 | 37407,20 | 7481,44 | 44888,64 |
| 13868 | Костюмы | шт. | 1495,00 | 40 | 59800,00 | 11960,00 | 71760,00 |
| Итого | 298727,28 |
Список использованной литературы:
1. Джон Уокенбах. Профессиональное программирование на VBA в Excel. Диалектика. М., С-Пб., Киев, 2003.
2. Г.В.Росляков. Программирование на VBA для Excel: Учеб. пособие. МГУДТ, 2006.
3. П.П. Мельников, И. В. Миронова, И. Ю. Шполянская. Практикум по экономической информатике. Часть III. Изд. «Перспектива», Москва 2002.