Офисное программирование. Специфика и примеры
Реквизиты покупателя
Согласно эскизу следующая часть шаблона бланка заказа содержит информацию о покупателе, - реквизиты организации, заказывающей товар. Мы уже имели дело с реквизитами офиса "РР" при построении шапки. При построении реквизитов покупателя можно было бы в качестве образца воспользоваться макросом "РеквизитыИРамка", слегка подкорректировав его. В каком-то смысле данная задача даже проще, поскольку не нужно заполнять значения полей, задающих реквизиты. Эту работу делает менеджер в момент оформления заказа. Уточним программу действий:
- Введем именование нашего бланка.
- Зададим поля реквизитов организации заказчика (покупателя). Мы уже умеем это делать. Особенность в том, что поля с названиями реквизитов задаются, а поля с их значениями остаются пустыми..
- Зададим поля реквизитов грузоотправителя и грузополучателя.
- Для объединения всех элементов этой части бланка, а также из эстетических соображений заключим их в рамку. Сделаем одно нововведение и построим рамку с надписью.
- Отчеркнем эту часть бланка
Вот текст соответствующего макроса, записавшего мои действия:
Sub РеквизитыЗаказчика()
'
' РеквизитыЗаказчика Macro
' Macro recorded 28.11.1999 by Vladimir Billig
' Именование бланка
Range("C16:I16").Select
Selection.MergeCells = True
ActiveCell.FormulaR1C1 = "СЧЕТ-ФАКТУРА № от "
With ActiveCell.Characters(Start:=1, Length:=31).Font
.FontStyle = "Полужирный"
.Size = 14
End With
With ActiveCell.Characters(Start:=32).Font
.FontStyle = "Полужирный Курсив"
.Size = 11
End With
'Задание полей реквизитов заказчика
Range("B19:C19").Select
Selection.MergeCells = True
ActiveCell.FormulaR1C1 = "Покупатель"
Range("B20:C20").Select
Selection.MergeCells = True
ActiveCell.FormulaR1C1 = "Адрес"
Range("B21:C21").Select
Selection.MergeCells = True
ActiveCell.FormulaR1C1 = "Тел., Факс, Email"
Range("B22:C22").Select
Selection.MergeCells = True
ActiveCell.FormulaR1C1 = "ИНН"
Range("D19:J19").Select
Selection.MergeCells = True
Range("D20:J20").Select
Selection.MergeCells = True
Range("D21:J21").Select
Selection.MergeCells = True
Range("D22:J22").Select
Selection.MergeCells = True
'Создание рамки
ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, _
34.5, 231.75, 452.25, 63.75).Select
Selection.ShapeRange.Fill.Visible = msoFalse
'Надпись на рамке
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
95, 225, 60, 15).Select
Selection.Characters.Text = "Покупатель"
'Реквизиты грузоотправителя и грузополучателя
Range("B25:D25").Select
Selection.MergeCells = True
ActiveCell.FormulaR1C1 = "Грузоотправитель и его адрес"
Range("E25:J25").Select
Selection.MergeCells = True
Range("B26:D26").Select
Selection.MergeCells = True
ActiveCell.FormulaR1C1 = "Грузополучатель и его адрес"
Range("E26:J26").Select
Selection.MergeCells = True
Range("B25:J26").Select
Selection.Font.FontStyle = "Полужирный Курсив"
Selection.Font.Size = 9
'Отчеркивание
ActiveSheet.Shapes.AddLine(44.25, 357.75, 500.25, 357.75).Select
Selection.ShapeRange.Line.Style = msoLineThinThin
Selection.ShapeRange.Line.Weight = 3#
Selection.ShapeRange.Line.ForeColor.SchemeColor = 48
Selection.ShapeRange.Line.Visible = msoTrue
End Sub
Листинг
6.23.
Запустив макрос "РеквизитыЗаказчика", на рабочем листе с уже созданной шапкой я получил следующую часть бланка:
Раздел "Таблица заказа"
Основная часть этого бланка - таблица со сведениями о заказываемых товарах. Сетка, которая обычно очерчивает границы ячеек рабочего листа, была удалена, на электронном бланке заказа она неуместна. Теперь необходимо восстановить некоторые из этих границ, чтобы нарисовать таблицу в привычной для глаз форме. На этом этапе я буду работать с вкладкой Borders ("Границы"), открываемой в окне Format Cells ("Формат ячеек") из меню Format ("Формат"). С объектной точки зрения границы объекта класса Range составляют коллекцию Borders. Меняя свойства элементов этой коллекции (объектов Border), можно добиться нужного эффекта. Я построю таблицу в три этапа:
- столбцы таблицы;
- шапку таблицы с заголовками полей;
- последнюю, итоговую строку.
Такое разделение сделает обозримыми макросы, транслирующие мои действия в тексты на VBA.
Построение столбцов
Столбцы таблицы это ее поля. Размер поля, его ширина зависит от содержания поля. В Excel требуемого размера можно достичь двумя путями объединением (слиянием) ячеек, составляющих одно поле, или изменением размера соответствующего столбца Excel, отведенного для поля. Поскольку второй способ действует на всю таблицу и может привести к изменению внешнего вида уже сформатированного листа, то применять его следует с определенной осторожностью. При применении такого способа рекомендуется начинать форматирование документа с создания таблицы и соответствующего изменения размеров ее столбцов. В данном случае применяются оба способа, изменяются размеры нескольких столбцов и сливаются ячейки для поля, задающего название товара.
Для решения задачи я выделил первую строку таблицы, слиянием ячеек и передвижкой границы между столбцами добился нужных размеров полей таблицы, а затем, используя вкладку "Границы", выделил внешние и внутренние вертикальные границы. После чего осталось скопировать формат этой строки на нужное количество строк таблицы. Вот макрос, выполняющий эти действия:
Sub СтолбцыТаблицы()
'
' СтолбцыТаблицы Macro
' Macro recorded 29.11.1999 by Vladimir Billig
'Изменение ширины полей, меняя размеры столбцов
Columns("E:E").ColumnWidth = 4
Columns("F:F").ColumnWidth = 4
Columns("I:I").ColumnWidth = 4.43
Columns("K:K").ColumnWidth = 11.86
'Слияние ячеек для поля Название Товара
Range("A32:D32").Select
Selection.MergeCells = True
'Выделение внешних границ: слева,снизу, справа
Range("A32:K32").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
'Выделение вертикальной внутренней границы
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
'Копирование формата на всю область таблицы
Selection.Copy
Range("A33:K46").Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
Листинг
6.24.
Шапка таблицы
Шапка таблицы будет состоять из двух строк, в первой содержатся названия полей, во второй их индексы. Используя соответствующие атрибуты на вкладке Alignment (Выравнивание), я задал центрирование текста по вертикали и горизонтали, а также автоматическое изменение высоты строки, чтобы текст названия полей был полностью видимым. Кроме того, я выделил графически границы шапки, задав их двойными линиями. Макрос получается, конечно, большим, поскольку оперирует с большим числом объектов. Вот его текст:
Sub ШапкаТаблицы()
'
' ШапкаТаблицы Macro
' Macro recorded 29.11.1999 by Vladimir Billig
'
'Именование полей таблицы и задание индексов
Range("A32:D32").Select
ActiveCell.FormulaR1C1 = "Наименование товара"
Range("E32").Select
ActiveCell.FormulaR1C1 = "Единица измерения"
Range("F32").Select
ActiveCell.FormulaR1C1 = "Количество"
Range("G32").Select
ActiveCell.FormulaR1C1 = "Цена"
Range("H32").Select
ActiveCell.FormulaR1C1 = "Сумма"
Range("I32").Select
ActiveCell.FormulaR1C1 = "Ставка НДС"
Range("J32").Select
ActiveCell.FormulaR1C1 = "Сумма НДС"
Range("K32").Select
ActiveCell.FormulaR1C1 = "Всего с НДС"
Range("A33:D33").Select
ActiveCell.FormulaR1C1 = "1"
Range("E33").Select
ActiveCell.FormulaR1C1 = "2"
Range("F33").Select
ActiveCell.FormulaR1C1 = "3"
Range("G33").Select
ActiveCell.FormulaR1C1 = "4"
Range("H33").Select
ActiveCell.FormulaR1C1 = "5"
Range("I33").Select
ActiveCell.FormulaR1C1 = "6"
Range("J33").Select
ActiveCell.FormulaR1C1 = "7"
Range("K33").Select
ActiveCell.FormulaR1C1 = "8"
'Центрирование текста и изменение высоты строки,
'обеспечивающее видимость текста
Range("A32:K33").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
End With
'Выделение границ шапки
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End Sub
Листинг
6.25.
Последняя строка
Последняя строка, как и строки шапки, отличается от остальных строк таблицы. Она используется для подведения итогов. Также как и шапку, я выделил ее границы графически. Итак, макрос "ПоследняяСтрока":
Sub ПоследняяСтрока()
'
' ПоследняяСтрока Macro
' Macro recorded 29.11.1999 by Vladimir Billig
'
'Задание итоговой строки
Range("A46:D46").Select
ActiveCell.FormulaR1C1 = "Всего к оплате"
Range("A46:K46").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Полужирный"
.Size = 11
End With
'Выделение границ итоговой строки
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
End Sub
Листинг
6.26.
Задание расчетных формул и форматирование полей
Одно из преимуществ построения таблиц в Excel состоит в том, что можно задать формулы для автоматического подсчета значений некоторых полей таблицы. В нашем случае все поля, задающие суммы, будут вычисляться по формулам. Формулы для расчета сумм достаточно очевидны и я не буду их выписывать. В тексте макроса они приведены. При работе вручную я в соответствующих столбцах для сумм задал эти формулы в первой рабочей строке таблицы, а затем скопировал их на оставшиеся рабочие строки. В строке итогов я задал суммирование по столбцам таблицы. Для столбцов таблицы я задал также подходящее форматирование данных. Вот текст макроса "Расчеты":
Sub Расчеты()
'
' Расчеты Macro
' Macro recorded 29.11.1999 by Vladimir Billig
'
'Форматирование полей и задание расчетных формул
'Форматирование поля "Название товара"
Range("A34:D45").Select
Selection.ShrinkToFit = True
'Форматирование поля "Единица Измерения"
Range("E34:E45").Select
Selection.HorizontalAlignment = xlCenter
'Форматирование поля "Цена"
Range("G34:G45").Select
Selection.NumberFormat = "0.00"
'Форматирование поля "Сумма"
Range("H34:H46").Select
Selection.NumberFormat = "0.00"
'Формула: Сумма = Цена * Количество
Range("H34").Select
ActiveCell.FormulaR1C1 = "=RC[-2]*RC[-1]"
'Копирование формулы
Range("H34").Select
Selection.AutoFill Destination:=Range("H34:H45"), Type:=xlFillDefault
Range("H34:H45").Select
'Итоговая сумма
Range("H46").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-12]C:R[-1]C)"
'Форматирование поля "НДС"
Range("I34:I45").Select
Selection.NumberFormat = "0%"
'Форматирование поля "Сумма НДС"
Range("J34:J46").Select
Selection.NumberFormat = "0.00"
'Формула: Сумма НДС = Сумма * НДС
Range("J34").Select
ActiveCell.FormulaR1C1 = "=RC[-2]*RC[-1]"
'Копирование формулы
Range("J34").Select
Selection.AutoFill Destination:=Range("J34:J45"), Type:=xlFillDefault
Range("J34:J45").Select
'Итоговая сумма
Range("J46").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-12]C:R[-1]C)"
'Форматирование поля "Всего с НДС"
Range("K34:K46").Select
Selection.NumberFormat = "0.00"
'Формула: Всего с НДС = Сумма + Сумма НДС
Range("K34").Select
ActiveCell.FormulaR1C1 = "=RC[-3]+RC[-1]"
'Копирование формулы
Range("K34").Select
Selection.AutoFill Destination:=Range("K34:K45"), Type:=xlFillDefault
Range("K34:K45").Select
'Итоговая сумма
Range("K46").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-12]C:R[-1]C)"
Range("K47").Select
'Нулевые значения в таблице не отображаются
ActiveWindow.DisplayZeros = False
End Sub
Листинг
6.27.
Я собрал макросы, строящие отдельные части таблицы под одной обложкой в макросе "ТаблицаРасчеты":
Sub ТаблицаРасчеты() 'Построение таблицы СтолбцыТаблицы ШапкаТаблицы ПоследняяСтрока Расчеты End SubЛистинг 6.28.
Запустив этот макрос на листе Excel, я получил таблицу, готовую для заполнения. Вот как она выглядит с заполненными двумя строчками. Заметьте, что все расчеты в ней ведутся автоматически.
Заключительный макрос "УтверждающиеПодписи"
Для полноты картины закончим создание бланка утверждающими подписями. Ни в действиях, ни в макросе, записывающем эти действия нет никаких особенностей, о которых стоило бы говорить. Это рутинная работа по помещению текста в ячейки Excel с подходящим для данного случая форматированием этого текста. Приведу текст этого макроса:
Sub УтверждающиеПодписи()
'
' УтверждающиеПодписи Macro
' Macro recorded 29.11.1999 by Vladimir Billig
'
Range("B50:G50").Select
Selection.MergeCells = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Полужирный Курсив"
.Size = 11
End With
ActiveCell.FormulaR1C1 = "Ген. Директор _________________________"
Range("B52:G52").Select
Selection.MergeCells = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Полужирный Курсив"
.Size = 11
End With
Range("B52:G52").Select
ActiveCell.FormulaR1C1 = "Гл. Бухгалтер __________________________"
Range("B55").Select
ActiveCell.FormulaR1C1 = "М. П."
End Sub
Сборка макросов. Макрос "СчетФактура"
Для завершения работы и получения макроса, который строит шаблон бланка "Счет-Фактура", осталось собрать все макросы, строящие отдельные части бланка. Вот текст заключительного макроса:
Sub СчетФактура()
'Этот заключительный макрос строит шаблон бланка Счет-Фактура
'Он вызывает макросы, строящие отдельный части этого бланка
Шапка
РеквизитыЗаказчика
ТаблицаРасчеты
УтверждающиеПодписи
End Sub
Листинг
6.29.
Запустив этот макрос на чистом листе Excel, я получил полностью сформированный бланк, который в дальнейшем можно использовать в качестве соответствующего шаблона.

