Видеоуроки бесплатно!

Практикум Visual Basic Excel

Сказки на ночь

ПРАКТИКУМ Создание отчетов в Word с помощью расширенного фильтра

  

В главе, "Анализ данных с помощью расширенного фильтра", рассматривался макрос, использующий расширенный фильтр для создания отчетов по каждому
заказчику и сохраняющий их в виде отдельных рабочих книг. Изменим условие задачи, потребовав сохранения полученных отчетов в виде документов Word. Ниже приведена последовательность действий, которые нужно выполнить для достижения поставленной цели.
1. Создайте новый документ Word. Добавьте в него закладки Заказчик и Таблица, а также, при необходимости, дополнительный текст, который нужно поместить в отчет. Сохраните документ в виде шаблона с именем SalesReport .dot.
2. Внесите изменения в макрос RunReportForEachCustomer (см. главу 11). После применения расширенного фильтра для генерирования отчета в Excel создайте документ Word на основе шаблона SalesReport. dot.
3. С помощью метода insertBefore поместите имя заказчика в позицию закладки Заказчик в новом документе Word.
4. Поместите отчет в позицию закладки Таблица в новом документе Word. Добавьте полужирное начертание к первой строке таблицы (строке заголовков).
Ниже приведен код макроса RunReportForEachCustomer со всеми необходимыми изменениями.
Ниже приведен код макроса RunReportForEachCustomer со всеми необходимыми изменениями.

Sub RunReportForEachCustomer()
Dim IRange As Range
Dim ORange As Range
Dim CRange As Range
Dim WBN As Workbook
Dim WSN As Worksheet
Dim WSO As Worksheet
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdRng As Word.Range
Application.ScreenUpdating = False
Set WSO = ActiveSheet
' Определение размера исходного диапазона данных.
FinalRow = 06113(65536,   1).End(xlUp).Row
NextCol = Cells(l,   255).End(xlToLeft).Column + 2
' Первый расширенный фильтр - создание
' списка заказчиков в столбце J.
' Определение целевого диапазона.
' Копирование заголовка столбца А в ячейку Л.
RangeC'Al") .Copy Destination: =Cells (1, NextCol)
Set ORange = Cells(1, NextCol)
' Определение исходного диапазона данных.
Set IRange = Range("A1").Resize(FinalRow, NextCol - 2)
'  Применение расширенного фильтра для отбора
'  уникальных значений из столбца А.
IRange.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:="",  CopyToRange:=ORange,  Unique:=True
FinalCust = 06113(65536, NextCol).End(xlUp).Row
'  Цикл по списку заказчиков.
For Each cell In Cells(2, NextCol).Resize(FinalCust
ThisCust = cell.Value
'  Определение условия отбора.
Cellsd,  NextCol + 2).Value = Range("Al").Value
Cells(2, NextCol + 2).Value = ThisCust
Set CRange = Cellsd, NextCol + 2).Resize(2, 1)
'  Определение целевого диапазона данных.
'  В целевой диапазон войдут столбцы В  (Код),
'  С  (Розничная цена),  D (Продано) и Е (Остаток).
Cellsd,  NextCol + 4).Resized,   4) .Value = _
Array (Cells (1,   2),  Cellsd,   3), Cellsd,   4),  Cellsd, 5)
Set ORange = Cellsd, NextCol + 4).Resized, 4)
'  Второй расширенный фильтр - отбор строк,
'  удовлетворяющих заданному условию.
IRange.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=CRange,  CopyToRange:=0Range
' Добавить итоговую строку.
TotalRow = WSO.Cells(65536, _
ORange.Columns(1).Column).End(xlUp).Row + 1
WSO.Cells(TotalRow,  ORange.Columns(1).Column).Value=_
"Всего"
'  В англоязычной версии Excel:
'WSO.Cells(TotalRow, _
ORange.Columns (2) .Column) .FormulaRlCl = 11 =SUM(R2C :R[-1 ]С
WSO.Cells(TotalRow,
ORange.Columns(2).Column).FormulaRlClLocal = "=СУММ(R2C:R[-1]С)
1  В англоязычной версии Excel:
'WSO.Cells(TotalRow, _
ORange.Columns(4).Column).FormulaRlCl = "=SUM(R2C:R[-1]C)"
WSO.Cells(TotalRow, _
ORange.Columns(4).Column).FormulaRlClLocal = "=СУММ(R2C:R[-1]C)"
'  Создание нового документа Word.
On Error Resume Next
Set wdApp = GetObject(,   "Word.Application")
If wdApp Is Nothing Then Set wdApp = GetObject("", _
"Word.Application")
Set wdDoc = wdApp.Documents.Add(Template:= _
ThisWorkbook.Path & "SalesTemplate.dot")
wdDoc.Activate
'  Создание заголовка отчета.
wdDoc.Bookmarks("Заказчик").Range.InsertBefore (ThisCust)
'  Копирование отчета с рабочего листа Excel в документ Word.
WSO.Cellsd, NextCol + 4) .CurrentRegion.Copy
Set wdRng =
wdApp .ActiveDocument. Bookmarks (" Таблица11) . Range
wdRnq.Select
Форматирование таблицы.
With wdDoc.Application.Selection
.Paste
With wdDoc.Application.ActiveDocument.Tables(1)
.Rows.Alignment = wdAlignRowCenter
With .Rows(1)
.HeadingFormat = True
.Select
wdApp.Selection.Font.Bold = True
End With
End With
.HomeKey Unit:=wdStory,  Extend:=Move
End With
' Сохранение документа Word с последующим закрытием.
wdDoc.SaveAs ThisWorkbook.Path & "" & ThisCust & ".doc
wdDoc.Close savechanges:=False
WSO.Select
Set wdApp = Nothing
Set wdDoc = Nothing
Set wdRng = Nothing
' Очистить область вставки результата
' применения расширенных фильтров.
Cellsd, NextCol + 2).Resized,  10) . EntireColumn. Clear
Next cell
Application.ScreenUpdating = True
Cells(1, NextCol).EntireColumn.Clear
MsgBox FinalCust - 1 & " отчетов были успешно созданы
Set wdRng = Nothing
Sub

Результат выполнения макроса RunReportForEachCustomer показан на рис. 16.12.
ПРАКТИКУМ Создание отчетов в Word с помощью расширенного фильтра

Рис. 16.12. Пример создания отчета в Microsoft Word

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


Дата: 18 марта 2014   |   Опубликовал: Admin   |   Просмотров: 803   |   Комментарии (0)

Уважаемый , статьи ниже возможно будут интересны вам:

Посетители, находящиеся в группе Гости, не могут оставлять комментарии к данной публикации.