Офисное программирование. Специфика и примеры
Реквизиты покупателя
Согласно эскизу следующая часть шаблона бланка заказа содержит информацию о покупателе, - реквизиты организации, заказывающей товар. Мы уже имели дело с реквизитами офиса "РР" при построении шапки. При построении реквизитов покупателя можно было бы в качестве образца воспользоваться макросом "РеквизитыИРамка", слегка подкорректировав его. В каком-то смысле данная задача даже проще, поскольку не нужно заполнять значения полей, задающих реквизиты. Эту работу делает менеджер в момент оформления заказа. Уточним программу действий:
- Введем именование нашего бланка.
- Зададим поля реквизитов организации заказчика (покупателя). Мы уже умеем это делать. Особенность в том, что поля с названиями реквизитов задаются, а поля с их значениями остаются пустыми..
- Зададим поля реквизитов грузоотправителя и грузополучателя.
- Для объединения всех элементов этой части бланка, а также из эстетических соображений заключим их в рамку. Сделаем одно нововведение и построим рамку с надписью.
- Отчеркнем эту часть бланка
Вот текст соответствующего макроса, записавшего мои действия:
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, я получил полностью сформированный бланк, который в дальнейшем можно использовать в качестве соответствующего шаблона.