**************
* Программа..:  Best-4+
* Автор......: Titov
* Назначение.: Сводная таблица 
******

// Copyright (c) 1993-2005 "Компания БЭСТ". Все права сохраняются.
#include "excel.ch"
#include "inkey.ch"
#include "s_public.ch"
#include "s_refer.ch"
#include "task.ch"

#ifndef __HARBOUR__

PROCEDURE PivotA()
SAYERROR("В данной конфигурации режим не поддерживается!"
RETURN


#else

#include "assocarr.ch"
#include "excel.ch"
#define _TMP_DIR m->GlobalTmpPath
#translate Data_Valid( <var1>, <var2> ) => ;
           IF( <var1> >= <var2>,.T.,SayError("Дата не может быть меньше чем "+DTOC( <var2> )))




PROCEDURE PivotA(nVid)
LOCAL nTop := INT(MAXROW()/2-5), nLeft := INT(MAXCOL()/2-20)
LOCAL aSet := SaveSet(), aSetKeys := SaveSetKey()
LOCAL cTemp,cTempDbf,cTemp0,cTempi
LOCAL nRec:=0,nCol,nMonth,cMonth
LOCAL nProces,oRange,cYear
LOCAL aBases:={"MDoc","MDocM","MLabel","MGrup","MSclad"}
LOCAL aStru:={},cFilter,cKey,oGet,cHead,nOrdMoves
LOCAL aDiscret:={;
{1,'месяц   '},;
{2,'неделя  '},;
{3,'сутки   '},;   
{4,'документ'};   
}


FIELD Sclad,Vid,Type,CodeDoc,NumDoc,Grup,NNum,Date
PRIVATE pVid
DO CASE
   CASE nVid=1
   pVid:="1"
   cHead:="Сводная таблица поступлений"
   CASE nVid=2
   pVid:="2"
   cHead:="Сводная таблица расходов"
   CASE nVid=3
   pVid:="2"
   cHead:="Сводная таблица продаж"
   AADD(aBases,"RBook")
   CASE nVid=4
   pVid:="2"
   cHead:="Сводная таблица прибыли"
   AADD(aBases,"RBook")
ENDCASE

PRIVATE aIn[3]
aIn[1]:=m->CURR_BEG
aIn[2]:=DATE()
aIn[3]:=1


RestPar('MLab')


AEVAL(aBases,{|x|NetUse(x,x,,,,.T.)})
nOrdMoves:=Moves->(ORDSETFOCUS(2)) //vid+type

IF .T.
   IF nVid>2
      SELECT MDoc
      SET RELATION TO UPPER(LEFT(DopCode,6)) INTO RBook
   ENDIF

   SELECT MDocM
   ORDSETFOCUS("MDocM_D")
   IF nVid<=2
      SET RELATION TO UPPER(Sclad+Vid+Type+DTOS(Date)+CodeDoc+NumDoc) INTO MDoc
   ELSE
      SET RELATION TO UPPER(Sclad+Vid+Type+DTOS(Date)+CodeDoc+NumDoc) INTO MDoc

   ENDIF
  
   SETCOLOR(COL_BROWSE)
   ShadowBox(SPACE(1)+cHead+SPACE(1), ;
           nTop,nLeft,nTop+6,nLeft+50,,,.T.)

   @ nTop+2, nLeft+6 SAY "Период  с.............:"
   @ nTop+2, nLeft+31 GET aIn[1] VALID {|| Data_Valid(aIn[1], CURR_BEG) }
   @ nTop+3, nLeft+6 SAY "        по............:"
   @ nTop+3, nLeft+31 GET aIn[2] VALID {|| Data_Valid(aIn[2], aIn[1]) }
   @ nTop+4, nLeft+6 SAY 'Дискретность расчета  :' COLOR COL_BROWSE
   oGet:=GetNew(nTop+4,nLeft+31,{|x|RotateBlock(x,aDiscret,'aIn[3]')},'aIn[3]') //,,COL_GET)
   oGet:reader:={|x|RotateAndReader(x,aDiscret)}
   oGet:display()
   AADD(m->GetList, oGet)
   
   
   SETCOLOR(COL_GET)
   SET CURSOR ON
   READ
   SET CURSOR OFF
   IF LASTKEY() != K_ESC
      Busy(.T.,"Подготовка данных")

      AADD(aStru,{'Год','C',4,0})
      AADD(aStru,{'Квартал','C',7,0})
      AADD(aStru,{'Месяц','C',15,0})
      cKey:="STR(YEAR(Date),4,0)+STR(MONTH(Date),2,0)"

      IF aIn[3] > 1
         AADD(aStru,{'Неделя','C',22,0})
         cKey:="STR(YEAR(Date),4,0)+STR(WEEK(Date),2,0)"
      ENDIF
      IF aIn[3] > 2
         AADD(aStru,{'Дата','D',8, 0 })
         cKey:="DTOS(Date)"
      ENDIF


      IF aIn[3] > 3
         AADD(aStru,{'Документ','C',10, 0 })
         cKey:="UPPER(Sclad+Type+CodeDoc+NumDoc)+DTOS(Date)"
      ENDIF
      IF aIn[3]<4
         cKey+="+UPPER(Type+Sclad+Schet+Grup+NNum+MDoc->(Schet_A+AgentName))"
      ENDIF

      AADD(aStru,{'Вид_движ','C',25,0})
      AADD(aStru,{'Склад','C',25,0})
   
      AADD(aStru,{'Счет_оприх','C',10,0})
      AADD(aStru,{'Группа','C',34,0})
      AADD(aStru,{'Товар','C',34,0})
      

      AADD(aStru,{'Счет_контр','C',10,0})
      AADD(aStru,{'Контрагент','C',25,0})

      IF nVid>2
         AADD(aStru,{'Торг_агент','C',25,0})
         AADD(aStru,{'Регион','C',15,0})
         cKey+="+UPPER(RBook->(AgentNam+Region))"
      ENDIF

      AADD(aStru,{'Сумма','N',19,3})


      cTemp0 := TEMPFILE( _TMP_DIR,"DBF" )
      cTempi := TEMPFILE( _TMP_DIR,"CDX" )
      
      IF !EMPTY(aIn[1])
         MDocM->(DBSEEK(DTOS(aIn[1])))
      ENDIF
      cFilter:="!EMPTY(Sclad).AND.EMPTY(Input1).AND.Vid==pVid.AND.Type!='4'"
      cFilter+=".AND.Date>=aIn[1].AND.Date<=aIn[2]"
      

      CreIndex(cTempi,cKey,cFilter)
      IF nVid<=2
         TOTAL(cKey,{'Sum'},cTemp0)
      ELSEIF nVid=3
         TOTAL(cKey,{'SumOutR'},cTemp0)
      ELSE
         TOTAL(cKey,{'SumOutR','Sum'},cTemp0)
      ENDIF

      SELECT(0)
     
      cTemp := TEMPFILE( _TMP_DIR, )
      FERASE( cTemp )
      cTempDbf := cTemp+'DBF'

      DBCREATE(cTempDbf,aStru)
      USE
      USE (cTempDbf) ALIAS TempDbf NEW EXCLUSIVE
      NetUse("Temp0",cTemp0,,,,.T.)
      SET RELATION TO ;
      UPPER(Sclad+Vid+Type+DTOS(Date)+CodeDoc+NumDoc) INTO MDoc,;
      UPPER(Grup) INTO MGrup,;
      UPPER(Grup+NNum) INTO MLabel,;
      UPPER(Vid+Type) INTO Moves,;
      UPPER(Sclad) INTO MSclad
      nProces:=Proces_ini(Temp0->(LASTREC()),,, 'Подготовка данных')
      WHILE !EOF()
         Proces_update(nProces)
         SELECT TempDbf
         AddRec()
         nRec++
         cYear:=STR(YEAR(Temp0->Date),4,0)
         FIELDPUT(1,cYear)
         FIELDPUT(2,cYear+"."+STR(Quarter(Temp0->Date),1,0))
         nMonth:=MONTH(Temp0->Date)
         cMonth:=IF(nMonth<10,"0"+STR(nMonth,1,0),STR(nMonth,2,0))
         FIELDPUT(3,cYear+"."+cMonth)
         nCol:=4
         IF aIn[3] > 1
            FIELDPUT(nCol++,cYear+"."+cMonth+"."+MyWeek(Temp0->Date))
         ENDIF
         IF aIn[3] > 2
            FIELDPUT(nCol++,Temp0->Date)
         ENDIF
         IF aIn[3] > 3
            FIELDPUT(nCol++,Temp0->(CodeDoc+SPACE(1)+NumDoc))
         ENDIF
         FIELDPUT(nCol++,Moves->Name)
         FIELDPUT(nCol++,MSclad->ShortName)

         FIELDPUT(nCol++,Temp0->Schet)
         FIELDPUT(nCol++,MGrup->Name)
         FIELDPUT(nCol++,MLabel->Name)
         

         FIELDPUT(nCol++,MDoc->Schet_A)
         FIELDPUT(nCol++,MDoc->AgentName)
         IF nVid<=2
            FIELDPUT(nCol++,Temp0->Sum)
         ELSEIF nVid>2
            FIELDPUT(nCol++,RBook->AgentNam)
            FIELDPUT(nCol++,RBook->Region)
            IF nVid=3
               FIELDPUT(nCol++,Temp0->SumOutR)
            ELSE
               FIELDPUT(nCol++,Temp0->(SumOutR-Sum))
            ENDIF
         ENDIF
         SELECT Temp0
         SKIP
      ENDDO
      SELECT TempDbf
      nCol:=FCOUNT()
      CLOSE
      Proces_End(nProces)
      Busy(.F.)
      IF nRec=0
         SayError("Нет данных,удовлетворящим условиям фильтра!")
      ELSE
         PivotTable(cTempDbf,nRec,nCol,cHead,nVid)
      ENDIF
      
   ENDIF
   
ENDIF


Moves->(ORDSETFOCUS(nOrdMoves)) // постоянно открыт


DBCLOSEBASES(aBases)


FERASE(cTempDbf)



RestSetKey(aSetKeys)

RestSet(aSet)

RETURN


FUNCTION MyWeek(d)
LOCAL nDay:=DOW(d)-1
d-=(DOW(d)-2)
RETURN LEFT(DTOC(d),2)+"-"+LEFT(DTOC(d+6),2)


STATIC FUNCTION PivotTable(cFile,nRows,nCols,cHead,nVid)
LOCAL oApp,oAS,oWorkBook,bLastHandler,oRange
LOCAL oPivotCache,oPivotTable,cRange,lIsRus,cDecSep
LOCAL i,n,nCount1,nCount2,oField,nItem1,nItem2

Busy(.T.,"Построение сводной таблицы")

TRY
   oApp := CreateObject( "Excel.Application" )
CATCH
   Alert("Excel не доступен!")
   RETURN 0
END

IF VAL(oApp:Version)<9
   Alert("Требуется версия Excel 2000 и выше!")
   RETURN 0
ENDIF


oApp:Visible := .F.
oApp:screenUpdating:=.F.
lIsRus:=(oApp:International(xlCountryCode)==7)
cDecSep:=oApp:International(xlDecimalSeparator)



oWorkBook:=oApp:WorkBooks:Open(cFile)
oWorkBook:activate()


oAS:=oApp:ActiveSheet()
oAS:Name:=OEMTOANSI("Данные")
oAS:Cells:Font:Name := "Tahoma"
oAS:Cells:Font:Size := 8
oAS:Range("A1:"+CHR(ASC("A")+nCols-1)+"1"):Interior:colorIndex:=15

cRange:=oAS:Name+"!R1C1:R"+ALLTRIM(STR(nRows+1))+"C"+ALLTRIM(STR(nCols))
oPivotCache:=oWorkBook:PivotCaches:Add(1,cRange)


oAS:=oWorkbook:WorkSheets:Add()



oApp:calculation:=xlCalculationManual


oAS:Name:=OEMTOANSI("Сводная таблица")
oPivotTable:=oPivotCache:CreatePivotTable(oAS:RANGE("A1"),OEMTOANSI("Свод"),1)

oPivotTable:PivotFields(OEMTOANSI("Год")):Orientation:=xlPageField   
oPivotTable:PivotFields(OEMTOANSI("Квартал")):Orientation:=xlPageField 
oPivotTable:PivotFields(OEMTOANSI("Месяц")):Orientation:=xlPageField 
n:=3
IF aIn[3]>1
   oPivotTable:PivotFields(OEMTOANSI("Неделя")):Orientation:=xlPageField;n++  
ENDIF
IF aIn[3]>2
   oPivotTable:PivotFields(OEMTOANSI("Дата")):Orientation:=xlPageField;n++  
ENDIF
oPivotTable:PivotFields(OEMTOANSI("Счет_контр")):Orientation:=xlPageField;n++ 
oPivotTable:PivotFields(OEMTOANSI("Контрагент")):Orientation:=xlPageField;n++  
oPivotTable:PivotFields(OEMTOANSI("Вид_движ")):Orientation:=xlPageField;n++  
oPivotTable:PivotFields(OEMTOANSI("Счет_оприх")):Orientation:=xlPageField;n++  
oPivotTable:PivotFields(OEMTOANSI("Товар")):Orientation:=xlPageField;n++  
IF nVid>2
   oPivotTable:PivotFields(OEMTOANSI("Торг_агент")):Orientation:=xlPageField;n++  
   oPivotTable:PivotFields(OEMTOANSI("Регион")):Orientation:=xlPageField;n++  
ENDIF

oPivotTable:PivotFields(OEMTOANSI("Группа")):Orientation:=xlRowField  
oPivotTable:PivotFields(OEMTOANSI("Склад")):Orientation:=xlColumnField 
oPivotTable:PivotFields(OEMTOANSI("Сумма")):Orientation:=xlDataField 

oPivotTable:PivotFields(OEMTOANSI(IF(lIsRus,"Сумма по полю","Sum of")+" Сумма")):NumberFormat:="0"+cDecSep+"00"
oPivotTable:PivotFields(OEMTOANSI(IF(lIsRus,"Сумма по полю","Sum of")+" Сумма")):Caption:=OEMTOANSI("Сумма,"+m->GlobalValuta)

//Окрасим верхнюю часть
oAS:Range("A1:B"+ALLTRIM(STR(n))):interior:color:=RGB(200,200,200)
oAS:Range("B"+ALLTRIM(STR(n+2))):interior:color:=RGB(200,200,200)


nItem1:=n+4+oPivotTable:PivotFields(OEMTOANSI("Группа")):PivotItems:count
nItem2:=2+oPivotTable:PivotFields(OEMTOANSI("Склад")):PivotItems:count
//Окрасим заголовки
oAS:Range(oAS:Cells(n+3,1),oAS:Cells(nItem1-1,1)):interior:color:=RGB(200,200,200)
oAS:Range(oAS:Cells(n+3,2),oAS:Cells(n+3,nItem2)):interior:color:=RGB(200,200,200)

//Окрасим итоги
oAS:Range(oAS:Cells(nItem1,1),oAS:Cells(nItem1,nItem2)):interior:color:=RGB(128,255,255)
oAS:Range(oAS:Cells(n+3,nItem2),oAS:Cells(nItem1,nItem2)):interior:color:=RGB(128,255,255)


oRange:=oAS:Range("C1:E2")
oRange:font:bold:=.T.
oRange:HorizontalAlignment:=xlCenter
oRange:VerticalAlignment:=xlCenter
oRange:MergeCells:=.T.
oAS:Cells:Font:Size := 10

oRange:FormulaR1C1:=HB_OEMTOANSI(UPPER(cHead))

IF !EMPTY(aIn[2])
   oRange:=oAS:Range("C3:E3")
   oRange:font:bold:=.T.
   oRange:HorizontalAlignment:=xlCenter
   oRange:VerticalAlignment:=xlCenter
   oRange:MergeCells:=.T.
   oAS:Cells:Font:Size := 9
   oRange:FormulaR1C1:=HB_OEMTOANSI(DTOC(aIn[1])+" - "+DTOC(aIn[2]))
ENDIF


oAS:Cells:Font:Name := "Tahoma"
oAS:Cells:Font:Size := 8

oApp:screenUpdating:=.T.
oApp:calculation:=xlCalculationAutomatic


//oApp:CommandBars("PivotTable"):Visible:=.F.



Busy(.F.)

oApp:Visible := .T.


RETURN NIL

   
STATIC FUNCTION rgb( r,g,b )
RETURN ( r + ( g * 256 ) + ( b * 256 * 256 ) )

#endif




