НОУ ИНТУИТ | Основы офисного программирования и документы Word. Лекция 6: Офисное программирование. Специфика и примеры

Тверской государственный университет

Опубликован: 13.09.2006 | Доступ: свободный | Студентов: 2721 / 260 | Оценка: 4.03 / 3.74 | Длительность: 19:48:00

Темы: Программирование, Офисные технологии

Специальности: Программист, Менеджер

Вам нравится? Нравится 32 студентам

| Поделиться |

Поддержать курс

| Скачать электронную книгу

Реквизиты покупателя

Согласно эскизу следующая часть шаблона бланка заказа содержит информацию о покупателе, - реквизиты организации, заказывающей товар. Мы уже имели дело с реквизитами офиса "РР" при построении шапки. При построении реквизитов покупателя можно было бы в качестве образца воспользоваться макросом "РеквизитыИРамка", слегка подкорректировав его. В каком-то смысле данная задача даже проще, поскольку не нужно заполнять значения полей, задающих реквизиты. Эту работу делает менеджер в момент оформления заказа. Уточним программу действий:

Введем именование нашего бланка.
Зададим поля реквизитов организации заказчика (покупателя). Мы уже умеем это делать. Особенность в том, что поля с названиями реквизитов задаются, а поля с их значениями остаются пустыми..
Зададим поля реквизитов грузоотправителя и грузополучателя.
Для объединения всех элементов этой части бланка, а также из эстетических соображений заключим их в рамку. Сделаем одно нововведение и построим рамку с надписью.
Отчеркнем эту часть бланка

Вот текст соответствующего макроса, записавшего мои действия:

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.

Запустив макрос "РеквизитыЗаказчика", на рабочем листе с уже созданной шапкой я получил следующую часть бланка:

увеличить изображение
Рис. 6.7. Шапка и раздел с реквизитами заказчика

Раздел "Таблица заказа"

Основная часть этого бланка - таблица со сведениями о заказываемых товарах. Сетка, которая обычно очерчивает границы ячеек рабочего листа, была удалена, на электронном бланке заказа она неуместна. Теперь необходимо восстановить некоторые из этих границ, чтобы нарисовать таблицу в привычной для глаз форме. На этом этапе я буду работать с вкладкой 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, я получил таблицу, готовую для заполнения. Вот как она выглядит с заполненными двумя строчками. Заметьте, что все расчеты в ней ведутся автоматически.

увеличить изображение
Рис. 6.8. Таблица продажи товаров бланка Счет-Фактура

Заключительный макрос "УтверждающиеПодписи"

Для полноты картины закончим создание бланка утверждающими подписями. Ни в действиях, ни в макросе, записывающем эти действия нет никаких особенностей, о которых стоило бы говорить. Это рутинная работа по помещению текста в ячейки 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, я получил полностью сформированный бланк, который в дальнейшем можно использовать в качестве соответствующего шаблона.

Дальше >>

Авторизоваться

Основы офисного программирования и документы Word

Офисное программирование. Специфика и примеры

Реквизиты покупателя

Раздел "Таблица заказа"

Вопросы и ответы