5.3. Передача данных в Microsoft Excel

Отчеты, выполненные в конструкторе отчетов Visual FoxPro, не смотря на свою универсальность, значительно уступают таблицам Microsoft Excel в плане комфортности работы с отчетом. Рассмотрим на примере лицевого счета квартиросъемщика формирование отчета Excel из Visual FoxPro. Добавим кнопку Передать в Excel в форму Account  (рис. 5.5).

Код события Click кнопки Передать в Excel:

 


WAIT 'Ждите! Идет передача в Microsoft Excel' WINDOW NOWAIT

* Запущен ли Microsoft Excel на компьютере?

ON ERROR oExcel=.NULL.

* В случае возникновения ошибки в следующей строке считаем,

* что объекта oExcel нет

oExcel=GetObject(,"EXCEL.Application")

IF ISNULL(oExcel)

   * Excel не запущен

   ErrorExcel=.T.            && Excel на компьютере есть

   ON ERROR ErrorExcel=.F.   && Excel на компьютере нет

   * ErrorExcel=.F. в случае возникновения ошибки

   * в следующей строке при запуске Excel

   oExcel=CREATEOBJECT("EXCEL.Application")  && Запускаем Excel

   * Вернуть назад стандартную процедуру обработки ошибок 

   ON ERROR DO ERRORHND   

   IF ErrorExcel=.F.

      =MESSAGEBOX('На Вашем компьютере отсутствует '+;

                  'Microsoft Excel',48,'Ошибка!')

      RETURN

   ENDIF

ELSE

  =MESSAGEBOX('Microsoft Excel уже запущен! Найдите его '+;

              'на Панели задач внизу экрана',48,'Ошибка!')

  RETURN

ENDIF

* Локальные переменные

NachAll=0      && Начислено за месяц           

YmAll=0        && Уменьшено за месяц

DonaAll=0      && Доначислено за месяц

YpAll=0        && Уплачено за месяц

ReturnAll=0    && Возвращено за месяц

NachPeniAll=0  && Начислено пени за месяц

SpPeni=0       && Списано пени за месяц

UpPeni=0       && Уплачено пени за месяц

SaldoAll=0     && Сальдо на начало месяца

OstPenu=0      && Остаток пени

OstSht=0       && Остаток штрафа 

* Константы Microsoft Excel

#DEFINE True .T.

#DEFINE False .F.

#DEFINE xlLandscape   2

#DEFINE xlPaperA4   9

#DEFINE xlCenter   -4108

#DEFINE xlBottom   -4107

#DEFINE xlDiagonalDown   5

#DEFINE xlDiagonalUp   6

#DEFINE xlAutomatic   -4105

#DEFINE xlNone   -4142

#DEFINE xlEdgeLeft   7

#DEFINE xlContinuous   1

#DEFINE xlThin   2

#DEFINE xlAutomaticScale   -4105

#DEFINE xlEdgeTop   8

#DEFINE xlEdgeBottom   9

#DEFINE xlEdgeRight   10

#DEFINE xlInsideVertical   11

#DEFINE xlInsideHorizontal   12

#DEFINE xlLeft   -4131

#DEFINE xlTop   -4160

* Сделать окно Microsoft Excel видимым

oExcel.application.Visible=.T.

* Размеры окна и его место на экране дисплея

* oExcel.Application.Top = 65

* oExcel.Application.Left = 10

* oExcel.Application.Width = 470

* oExcel.Application.Height = 290

* Убираем панели инструментов

* Стандартная

oExcel.Application.CommandBars("Standard").Visible = False

* Форматирование

oExcel.Application.CommandBars("Formatting").Visible = False

* Добавляем рабочую книгу

oExcel.WorkBooks.Add

* При закрытии рабочей книги без сохранения

* ошибка формироваться не будет

oExcel.DisplayAlerts=False

* Масштаб изображения 75%

oExcel.ActiveWindow.Zoom = 75

* Заголовок окна Excel

oExcel.Caption=[Лицевой счет]

* Ориентация альбомная поля по 1.5 см Бумага A4

oExcel.ActiveSheet.PageSetup.LeftMargin=42

oExcel.ActiveSheet.PageSetup.RightMargin=42

oExcel.ActiveSheet.PageSetup.TopMargin =42

oExcel.ActiveSheet.PageSetup.BottomMargin=42

oExcel.ActiveSheet.PageSetup.Orientation = xlLandscape

oExcel.ActiveSheet.PageSetup.PaperSize = xlPaperA4

* Заголовок отчета

oExcel.Range("C1").Select

oExcel.ActiveCell.Font.Bold = True

oExcel.ActiveCell.Font.Size = 9

oExcel.ActiveCell.FormulaR1C1 =[Лицевой счет квартиросъемщика]

oExcel.Range("B2").Select

oExcel.ActiveCell.VerticalAlignment = xlTop

oExcel.ActiveCell.Font.Size = 7

AddressFlat=[Адрес квартиры: г. Хабаровск, ]

SELECT cBuilding

* Порядок следования в адресе

IF cBuilding.First=.F.

   * Признак адреса стоит первым

   RightAddress=ALLTRIM(cBuilding.Sign)+[ ]+;

                ALLTRIM(cBuilding.Name)

ELSE

    * Признак адреса стоит вторым

    RightAddress=ALLTRIM(cBuilding.Name)+[ ]+;

                 ALLTRIM(cBuilding.Sign)

ENDIF

AddressFlat=AddressFlat+RightAddress+[, дом ]+;

      ALLTRIM(SelectHouseAddress)+[, кв. ]+;

      ALLTRIM(STR(SelectFlat))+[.]

oExcel.ActiveCell.FormulaR1C1 =AddressFlat

oExcel.Range("A3").Select

oExcel.ActiveCell.VerticalAlignment = xlBottom

oExcel.ActiveCell.Font.Size = 4

oExcel.ActiveCell.FormulaR1C1 =[Copyright © 2006 ]+;

       [Программный комплекс "Учебный пример Real Estate" ]+;

       [написал Гурвиц Геннадий Александрович тел. 35-91-33 ]+;

       [Использованы продукты Microsoft Сorporation: ]+;

       [Microsoft Visual FoxPro 9.0 Service Pack 2, Microsoft ]+;

       [Visual Bаsic for applications, Microsoft Office 2003]

* Шрифт и центровка для всей таблицы

* oExcel.Cells.HorizontalAlignment = xlCenter

* oExcel.Cells.VerticalAlignment = xlBottom

* Надписи колонок

oExcel.Range("A4").Select

oExcel.ActiveCell.FormulaR1C1 = "Дата"

oExcel.Range("B4").Select

oExcel.ActiveCell.FormulaR1C1 = "Операция"

oExcel.Range("C4").Select

oExcel.ActiveCell.FormulaR1C1 = "Начислено"

oExcel.Range("D4").Select

oExcel.ActiveCell.FormulaR1C1 = "Уменьшено"

oExcel.Range("E4").Select

oExcel.ActiveCell.FormulaR1C1 = "Доначис."

oExcel.Range("F4").Select

oExcel.ActiveCell.FormulaR1C1 = "Уплачено"

oExcel.Range("G4").Select

oExcel.ActiveCell.FormulaR1C1 = "Возврат"

oExcel.Range("H4").Select

oExcel.ActiveCell.FormulaR1C1 = "Сальдо"

oExcel.Range("I4").Select

oExcel.ActiveCell.FormulaR1C1 = "Нач. пени"

oExcel.Range("J4").Select

oExcel.ActiveCell.FormulaR1C1 = "Количество дней пени"

oExcel.Range("K4").Select

oExcel.ActiveCell.FormulaR1C1 = "Сп. пени"

oExcel.Range("L4").Select

oExcel.ActiveCell.FormulaR1C1 = "Упл.пени"

oExcel.Range("M4").Select

oExcel.ActiveCell.FormulaR1C1 = "Ост.пени"

oExcel.Range("N4").Select

oExcel.ActiveCell.FormulaR1C1 = "Ост.штр"

* Устанавливаем ширину колонок

oExcel.Columns("A:A").ColumnWidth = 8

oExcel.Columns("B:B").ColumnWidth = 29

oExcel.Columns("C:C").ColumnWidth = 7

oExcel.Columns("D:D").ColumnWidth = 7

oExcel.Columns("E:E").ColumnWidth = 7

oExcel.Columns("F:F").ColumnWidth = 6

oExcel.Columns("G:G").ColumnWidth = 6

oExcel.Columns("H:H").ColumnWidth = 7

oExcel.Columns("I:I").ColumnWidth = 6

oExcel.Columns("J:J").ColumnWidth = 18

oExcel.Columns("K:K").ColumnWidth = 6

oExcel.Columns("L:L").ColumnWidth = 6

oExcel.Columns("M:M").ColumnWidth = 6

oExcel.Columns("N:N").ColumnWidth = 6

* Для всех заголовков столбцов жирный шрифт

oExcel.Rows("4:4").Font.Bold = True

oExcel.Rows("4:4").RowHeight = 15

oExcel.Rows("4:4").Font.Size = 7

oExcel.Rows("4:4").VerticalAlignment = xlCenter

oExcel.Rows("4:4").Interior.ColorIndex = 8

oExcel.Rows("4:4").HorizontalAlignment = xlCenter

* Обводим линиями шапку таблицы

oExcel.RANGE("A4:N4").Select

oExcel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone

* Левые вертикальные линии

With oExcel.Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = xlAutomatic

EndWith

* Верхние горизонтальные линии

With oExcel.Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = xlAutomatic

EndWith

* Нижние горизонтальные линии

With oExcel.Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = xlAutomatic

EndWith

* Правые вертикальные линии

With oExcel.Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = xlAutomatic

EndWith

* Правая вертикальная в последней ячейке

With oExcel.Selection.Borders(xlEdgeRight)

     .LineStyle = xlContinuous

     .Weight = xlThin

     .ColorIndex = xlAutomatic

EndWith

* Открытие таблицы-выборки лицевого счета

IF .NOT. USED('pAccount')

   USE pAccount in 0

ENDIF  

SELECT pAccount

nRow=5  && Дальнейший вывод с пятой строки

SignSaldoStart=0

SldRussia=0

SldKray=0

SCAN

 DO CASE

  CASE pAccount.Contents=[Сальдо старт]

       SignSaldoStart=1

       nRow=nRow+1 && Номер текущей строчки

       DO WRITE    && Вывод строки счета. Находится в FileProc

       oExcel.Rows(ALLTRIM(STR(nRow,3))+[:]+;

                 ALLTRIM(STR(nRow,3))).Font.Size = 7

       oExcel.Rows(ALLTRIM(STR(nRow,3))+[:]+;

                 ALLTRIM(STR(nRow,3))).RowHeight = 13.2

       oExcel.Rows(ALLTRIM(STR(nRow,3))+[:]+;

            ALLTRIM(STR(nRow,3))).HorizontalAlignment = xlCenter

       oExcel.Range([A]+ALLTRIM(STR(nRow,3))+[:]+;

                 [N]+ALLTRIM(STR(nRow,3))).Select

       * Левые вертикальные линии

       With oExcel.Selection.Borders(xlEdgeLeft)

               .LineStyle = xlContinuous

               .Weight = xlThin

               .ColorIndex = xlAutomatic

       EndWith

       * Верхние горизонтальные линии

       With oExcel.Selection.Borders(xlEdgeTop)

               .LineStyle = xlContinuous

               .Weight = xlThin

               .ColorIndex = xlAutomatic

       EndWith

       * Нижние горизонтальные линии

       With oExcel.Selection.Borders(xlEdgeBottom)

               .LineStyle = xlContinuous

               .Weight = xlThin

               .ColorIndex = xlAutomatic

       EndWith

       * Правые вертикальные линии

       With oExcel.Selection.Borders(xlInsideVertical)

               .LineStyle = xlContinuous

               .Weight = xlThin

               .ColorIndex = xlAutomatic

       EndWith

       * Правая вертикальная в последней ячейке

       With oExcel.Selection.Borders(xlEdgeRight)

               .LineStyle = xlContinuous

               .Weight = xlThin

               .ColorIndex = xlAutomatic

       EndWith

  CASE pAccount.Contents=[В т.ч Аренда]

          SldRussia=pAccount.Saldo

  CASE pAccount.Contents=[В т.ч НДС]

       SldKray=pAccount.Saldo

       IF SignSaldoStart=1

          * Добавление строчки после Сальдо старт

          nRow=nRow+1

          oExcel.Range([C]+ALLTRIM(STR(nRow,3))).Select

          oExcel.ActiveCell.FormulaR1C1=;

                        [Начальное сальдо (Оплата):  ]+;

                        ALLTRIM(STR(SldRussia,13,2))+;

                        [ руб.     Начальное сальдо (НДС):  ]+;

                        ALLTRIM(STR(SldKray,13,2))+[ руб.]

          oExcel.Rows(ALLTRIM(STR(nRow,3))+[:]+;

                  ALLTRIM(STR(nRow,3))).Font.Size = 7

          oExcel.Rows(ALLTRIM(STR(nRow,3))+[:]+;

                  ALLTRIM(STR(nRow,3))).Interior.ColorIndex = 35

          nRow=nRow+1

          oExcel.Rows(ALLTRIM(STR(nRow,3))+[:]+;

                  ALLTRIM(STR(nRow,3))).Interior.ColorIndex = 35

          StartRow=nRow

       ENDIF

       IF SignSaldoStart=0

          oExcel.Range([A]+ALLTRIM(STR(StartRow+1,3))+[:N]+;

                 ALLTRIM(STR(nRow,3))).Select

          oExcel.Selection.Borders(xlDiagonalUp).LineStyle=;

                                                          xlNone

          With oExcel.Selection

                  .HorizontalAlignment = xlCenter

          EndWith

          With oExcel.Selection.Font

                  .Size = 7

          EndWith    

          * Левые вертикальные линии

          With oExcel.Selection.Borders(xlEdgeLeft)

                  .LineStyle = xlContinuous

                  .Weight = xlThin

                  .ColorIndex = xlAutomatic

          EndWith

          * Верхние горизонтальные линии

          With oExcel.Selection.Borders(xlEdgeTop)

                  .LineStyle = xlContinuous

                  .Weight = xlThin

                  .ColorIndex = xlAutomatic

          EndWith

          * Нижняя горизонтальная линия в последней строке

          With oExcel.Selection.Borders(xlEdgeBottom)

                  .LineStyle = xlContinuous

                  .Weight = xlThin

                  .ColorIndex = xlAutomatic

          EndWith

          * Правые вертикальные линии

          With oExcel.Selection.Borders(xlInsideVertical)

                  .LineStyle = xlContinuous

                  .Weight = xlThin

                  .ColorIndex = xlAutomatic

          EndWith

          * Правая вертикальная в последней ячейке

          With oExcel.Selection.Borders(xlEdgeRight)

                  .LineStyle = xlContinuous

                  .Weight = xlThin

                  .ColorIndex = xlAutomatic

          EndWith

          * Нижние горизонтальные линии в каждой строке

          * Не выводить, если строчка всего одна

          IF StartRow+1#nRow

                With oExcel.Selection.Borders(xlInsideHorizontal)

                  .LineStyle = xlContinuous

                  .Weight = xlThin

                  .ColorIndex = xlAutomatic

                EndWith

           ENDIF

           * Добавление строчки после Сальдо

           nRow=nRow+1

           oExcel.Range([B]+ALLTRIM(STR(nRow,3))).Select

           oExcel.ActiveCell.FormulaR1C1=[Итого за месяц]

           oExcel.Range([C]+ALLTRIM(STR(nRow,3))).Select

           oExcel.ActiveCell.FormulaR1C1=NachAll

           oExcel.Range([D]+ALLTRIM(STR(nRow,3))).Select

           oExcel.ActiveCell.FormulaR1C1=YmAll

           oExcel.Range([E]+ALLTRIM(STR(nRow,3))).Select

           oExcel.ActiveCell.FormulaR1C1=DonaAll

           oExcel.Range([F]+ALLTRIM(STR(nRow,3))).Select

           oExcel.ActiveCell.FormulaR1C1=YpAll

           oExcel.Range([G]+ALLTRIM(STR(nRow,3))).Select

           oExcel.ActiveCell.FormulaR1C1=ReturnAll

           oExcel.Range([I]+ALLTRIM(STR(nRow,3))).Select

           oExcel.ActiveCell.FormulaR1C1=NachPeniAll

           oExcel.Range([K]+ALLTRIM(STR(nRow,3))).Select

           oExcel.ActiveCell.FormulaR1C1=SpPeni

           oExcel.Range([L]+ALLTRIM(STR(nRow,3))).Select

           oExcel.ActiveCell.FormulaR1C1=UpPeni

           oExcel.Rows(ALLTRIM(STR(nRow,3))+[:]+;

                  ALLTRIM(STR(nRow,3))).Font.Size = 7

           oExcel.Rows(ALLTRIM(STR(nRow,3))+[:]+;

                  ALLTRIM(STR(nRow,3))).Interior.ColorIndex = 35

           oExcel.Rows(ALLTRIM(STR(nRow,3))+[:]+;

            ALLTRIM(STR(nRow,3))).HorizontalAlignment = xlCenter

           * Еще одна строчка сводных данных

           nRow=nRow+1

           StartRow=nRow

           oExcel.Range([A]+ALLTRIM(STR(nRow,3))).Select

           oExcel.ActiveCell.FormulaR1C1=[На начало месяца]+;

           [ общее сальдо составляет:  ]+;

           ALLTRIM(STR(SaldoAll,13,2))+[ руб. В т.ч]+;

           [ Оплата:  ]+ALLTRIM(STR(SldRussia,13,2))+;

           [ руб.  В т.ч  НДС:  ]+ALLTRIM(STR(SldKray,13,2))+;

           [ руб. ]+[   Остаток пени: ]+;

           ALLTRIM(STR(OstPenu,13,2))+[ руб. Остаток штрафа: ]+;

           ALLTRIM(STR(OstSHT,13,2))+[ руб.]

           oExcel.Rows(ALLTRIM(STR(nRow,3))+[:]+;

                  ALLTRIM(STR(nRow,3))).Font.Size = 7

           oExcel.Rows(ALLTRIM(STR(nRow,3))+[:]+;

               ALLTRIM(STR(nRow,3))).Interior.ColorIndex = 35

           NachAll=0      && Начислено за месяц           

           YmAll=0        && Уменьшено за месяц

           DonaAll=0      && Доначислено за месяц

           YpAll=0        && Уплачено за месяц

           ReturnAll=0    && Возвращено за месяц

           NachPeniAll=0  && Начислено пени за месяц

           SpPeni=0       && Списано пени за месяц

           UpPeni=0       && Уплачено пени за месяц

        ENDIF

  CASE pAccount.Contents=[Сальдо      ]

       SignSaldoStart=0

       nRow=nRow+1

       NachPeniAll=NachPeniAll+pAccount.Npe   && Начислено пени

       SaldoAll=pAccount.Saldo     && Сальдо на начало месяца

       OstPenu=pAccount.OstPE      && Остаток пени

       OstSht=pAccount.OstSH       && Остаток штрафа 

       DO WRITE  && Вывод строки счета

  OTHERWISE

      nRow=nRow+1

      DO WRITE

      NachAll=NachAll+pAccount.Nach         && Начислено

      YmAll=YmAll+pAccount.YmYB             && Уменьшено

      DonaAll=DonaAll+pAccount.yPdona       && Доначислено

      YpAll=YpAll+pAccount.YpVs             && Уплачено

      ReturnAll=ReturnAll+pAccount.Vpe      && Возвращено

      NachPeniAll=NachPeniAll+pAccount.Npe  && Начислено пени

      SpPeni=SpPeni+pAccount.YpNedo         && Списано пени

      UpPeni=UpPeni+pAccount.RaYpvo         && Уплачено пени

   ENDCASE

ENDSCAN  

* Переход в начало отчета

oExcel.Range("A1").Select

* Устанавливаем защиту рабочего листа и книги

ProtectList=[oExcel.ActiveSheet.Protect("]+TIME()+[")]

ProtectBook=[oExcel.ActiveWorkbook.Protect("]+TIME()+[")]

&ProtectList

&ProtectBook

WAIT 'Таблица готова!' WINDOW NOWAIT

 

Вид готового отчета показан на рисунке. 5.6.