Форум

{5,24,11,11,11,10,10}

oAS:columns("B:B"):Rows:NumberFormat = "@"
 oAS:columns("F:F"):Rows:NumberFormat:=REPLICATE("#",10)+"0"+cDecSep+REPLICATE("0",2)

#include "excel.ch"
#define xlBottom -4107
#define PeriodToD(_p)     CToD("01/" + Right(_p, 2) + "/" + SubStr(_p, 3, 2))
#define A_ISKOP           If(CURR_MAIN > 0,, 1)

FUNCTION SBER()
   Local aSet,aSetKey
   Local cRange,cStrSum,aWide:={5,24,11,11,11,10,10}
   Local cCode:=_field->code,cName:=_field->NAME
   Local cPartner:=Any("Partner", "CODE",Upper(_FIELD->PARTNER), "SHORTNAME")
   Local cLb_name:=Space(6) + AllTrim(LBL_NAME) + "  за " +;
                 Lower(CMonth(PeriodToD(S_PERIOD))) + " " +;
                 Left(S_PERIOD, 4) + " г."
   Local cHead1:=_FIELD->HEAD1
   Local cHead2:=_FIELD->HEAD2
   PRIVATE cRang,i,cDecSep,cNomer:=1,nAllSum:=0
   PRIVATE oWorkBook,oApp,oAS,nKol,cMacro,aName,nRow,nRow0,nRow1,cString,cBuffer
ALTD()
   If !FindRec("Rectranc", "01", Upper(cCode))
    SayError("Список " + cCode + " пуст!", 15)
    Return ({0,0})
   EndIf

   If _FIELD->STATUS == "1"
    SayError("Список " + cCode + " не расчитан!", 15)
    Return ({0,0})
   EndIf

   aSet:=SaveSet()
   aSetKey:=SaveSetKey()

   DBPush("Rectranc", "01", "SUM>0", {"Upper(CODE)", Upper(cCode),, {"01"}})

   aName:={"cNomer","RECTRANC->NFACC","CARDSPRI->FAM","CARDSPRI->NAME","CARDSPRI->PATR",;
           "RECTRANC->SUM"}

   cBuffer:=""
   cMacro:=""
   IF !EMPTY(aPars).AND.LEN(aPars)=7
      FOR I:=1 to 7
         aWide[i]:=aPars[i]
      NEXT
   ENDIF
ALTD()
   If !rectranc->( DBGOTOP() )
    SayError("В списке " + cCode + " все строки с нулевой суммой!", 15)
    DBPOP()
    RestSetKey(aSetKey)
    RestSet(aSet)
    Return ({0,0})
   EndIf

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

   oApp:Visible := .T.
   oApp:screenUpdating:=.T.
   oApp:displayAlerts:=.T.
   oWorkBook:=oApp:WorkBooks:Add() 
   oAS:=oWorkBook:Worksheets():Add()

   oAS:Activate()
   cDecSep:=oApp:International(xlDecimalSeparator)
   oApp:calculation:=xlCalculationManual
   oAS:Cells:Font:Name := "Courier New"
   oAS:Cells:Font:Size := 8
   oAS:Name:=OemToAnsi("Список в сбербанк")
   FOR I:=1 to 8
      cRange:="A"+STR(i,1)+":G"+STR(i,1)
      oAS:Range(cRange):MergeCells:=.F.
      oAS:Range(cRange):Merge()
   NEXT
   oAS:Range("A1:G1"):HorizontalAlignment:= xlCenter
   oAS:Range("A1:G1"):Font:Bold:=.T.
   oAS:Range("A1"):Value:=OemToAnsi(ALLTRIM("СПИСОК N " + cCode + " " + cName))
   oAS:Range("A3"):Value:=OemToAnsi(Space(6) + "поданных в "+cPartner)
   oAS:Range("A4"):Value:=OemToAnsi(cLb_name)
   oAS:Range("A6"):Value:=OemToAnsi(cHead1)
   oAS:Range("A7"):Value:=OemToAnsi(cHead2)

//столбцы
   oAS:Range("A9"):Value:=OemToAnsi("№ п/п")
   oAS:Range("B9"):Value:=OemToAnsi("Лицевой счет")
   oAS:Range("C9"):Value:=OemToAnsi("Фамилия")
   oAS:Range("D9"):Value:=OemToAnsi("Имя")
   oAS:Range("E9"):Value:=OemToAnsi("Отчество")
   oAS:Range("F9"):Value:=OemToAnsi("Сумма")
   oAS:Range("G9"):Value:=OemToAnsi("Примечание")
   cRange:="A9:G9"
   oAS:Range(cRange):Borders(xlEdgeLeft):Weight:= xlThin
   oAS:Range(cRange):Borders(xlEdgeTop):Weight:= xlThin
   oAS:Range(cRange):Borders(xlEdgeBottom):Weight:= xlThin
   oAS:Range(cRange):Borders(xlEdgeRight):Weight:= xlThin
   oAS:Range(cRange):Borders(11):Weight:= xlThin
   oAS:Columns("A:A"):ColumnWidth:= aWide[1]
   oAS:Columns("B:B"):ColumnWidth:= aWide[2]
   oAS:Columns("C:C"):ColumnWidth:= aWide[3]
   oAS:Columns("D:D"):ColumnWidth:= aWide[4]
   oAS:Columns("E:E"):ColumnWidth:= aWide[5]
   oAS:Columns("F:F"):ColumnWidth:= aWide[6]
   oAS:Columns("G:G"):ColumnWidth:= aWide[7]
   oAS:columns("B:B"):Rows:NumberFormat = "@"
   oAS:columns("F:F"):Rows:NumberFormat:=REPLICATE("#",10)+"0"+cDecSep+REPLICATE("0",2)

   FOR i:=1 TO 6 //по колонкам идем
      cMacro+=IF(i=1,"","+")
      cMacro+="MY_XXTOC("+aName[i]+")+CHR(9)"
   NEXT
   cMacro:=SUBSTR(cMacro,1,LEN(cMacro)-6)+"CHR(13)+CHR(10)"
   nRow1:=nRow0:=nRow:=10
//заполняем строки таблицы   
   RECTRANC->(DBEVAL( {||str_excel()} ) )
   IF LEN(cBuffer)>0
       Wvt_SetClipBoard(cBuffer)
       oAs:Cells(nRow0,1):Select()
       oAS:Paste()
   ENDIF
ALTD()
   cRange:="A"+ALLTRIM(STR(nRow))+":E"+ALLTRIM(STR(nRow))
   oAS:Range(cRange):MergeCells:=.F.
   oAS:Range(cRange):Merge()
   oAS:Range("A"+ALLTRIM(STR(nRow))):Value:=OemToAnsi("Итого")
   oAS:Range("F"+ALLTRIM(STR(nRow))):Value:=nAllSum

//рисуем подвал
   nRow++
   FOR i:=nRow TO (nRow+3)
      cRange:="A"+ALLTRIM(STR(i))+":G"+ALLTRIM(STR(i))
      oAS:Range(cRange):MergeCells:=.F.
      oAS:Range(cRange):Merge()
   NEXT
   oAS:Range("A"+ALLTRIM(STR(nRow))):Value:=OemToAnsi(Space(6) + "Итого перечислено на сумму - " + LTrim(TransForm(nAllSum, RDFLOAT)))
   cRange:="A"+ALLTRIM(STR(nRow))+":G"+ALLTRIM(STR(nRow))
   oAS:Range(cRange):Borders(xlEdgeLeft):Weight:= xlThin
   oAS:Range(cRange):Borders(xlEdgeTop):Weight:= xlThin
   oAS:Range(cRange):Borders(xlEdgeBottom):Weight:= xlThin
   oAS:Range(cRange):Borders(xlEdgeRight):Weight:= xlThin
   nRow++
   cStrSum := NumToRus(nAllSum, GlobalValuta, A_ISKOP)
   oAS:Range("A"+ALLTRIM(STR(nRow))):Value:=OemToAnsi(SPACE(6)+cStrSum)
   nRow++
   oAS:Range("A"+ALLTRIM(STR(nRow))):Value:=OemToAnsi(Space(6)+"Руководитель........:  /            /  " +LBL_BOSS)
   nRow++
   oAS:Range("A"+ALLTRIM(STR(nRow))):Value:=OemToAnsi(Space(6) +"Главный бухгалтер...:  /            /  " + LBL_SHEF)
   cRange:="A"+ALLTRIM(STR(nRow))+":G"+ALLTRIM(STR(nRow))
   oAS:Range(cRange):Borders(xlEdgeLeft):Weight:= xlThin
   oAS:Range(cRange):Borders(xlEdgeTop):Weight:= xlThin
   oAS:Range(cRange):Borders(xlEdgeBottom):Weight:= xlThin
   oAS:Range(cRange):Borders(xlEdgeRight):Weight:= xlThin

   oAs:Range("A1"):Select()
   oApp:screenUpdating:=.T.
   oApp:calculation:=xlCalculationAutomatic
   oApp:displayAlerts:=.T.
   oApp:Visible := .T.

   DBPOP()
   RestSetKey(aSetKey)
   RestSet(aSet)
RETURN NIL

FUNCTION MY_XXTOC(uVal)
LOCAL cType:=VALTYPE(uVal),cFstr
DO CASE
   CASE cType = "N"
   cFStr := IF(uVal=0,"",STRTRAN(ALLTRIM(STR(uVal,19,4)),".",cDecSep))
   CASE cType = "D"
   cFStr := DTOC(uVal)
   CASE cType = "L"
   IF uVal
      cFStr := "True"
   Else
      cFStr := "False"
   EndIF
   CASE cType = "U"
   cFStr:=""
   OTHERWISE
   cFStr:=TRIM(uVal)
ENDCASE
RETURN cFstr

FUNCTION str_excel()
   Local nRec:=CARDSPRI->( RECNO() )
      CARDSPRI->(DBSEEK(UPPER(RECTRANC->TNUM)))
      IF nRow>nRow0
         oAS:Rows(nRow-1):Insert(xlDown)
         oAS:Rows(nRow):Copy(oAS:Rows(nRow-1))
      ENDIF
      cString:=&(cMacro)
      nAllSum+=RECTRANC->SUM
      cBuffer+=cString
      nRow++
      cNomer++
      IF LEN(cBuffer)>60000
         Wvt_SetClipBoard(cBuffer)
         oAs:Cells(nRow0,1):Select()
         oAS:Paste()
         cBuffer:=""
         nRow0:=nRow
      ENDIF
      CARDSPRI->( DBGOTO(nRec) )
RETURN NIL