BEST logo логотип компании БЭСТ - программы для бизнеса ПРОДАЖИ
+7 (991) 312-04-37
trade@bestnet.ru
ПОДДЕРЖКА
+7 (495) 775-66-76
consult@bestnet.ru
СКАЧАТЬ
Обновления
Дистрибутивы
Авторизация

Логин:
Пароль:
Забыли свой пароль?
Регистрация
ВАШ ВОПРОС

Доступ к Личному кабинету закрыт!
Как получить доступ?


Главная  / Поддержка  / Форум  / Публичные форумы  / Программирование приложений  / Списки в Сбербанк в формате Excel для БЭСТ-4

Форум

Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Списки в Сбербанк в формате Excel для БЭСТ-4
 
Ниже приводится исходный код плагина.

Описание решения:

Предназначено для режима:
Зарплата -> Выходные формы -> Списки и справки -> Списки в сбербанк
Подключение задачи:
1.Скачиваем прикрепленный файл usber.hrb
2.Кладем его в папку PRO\PLUGINS\EXTENSNS\SALARY
3.В указанном выше режиме подключаем:
- нажимаем CTRL_F5
- нажимаем F4
- заполняем:
- Наименование : Списки в сбербанк в Excel
- Имя файла : usber.hrb
- Параметры : Можно не заполнять
Примечание
В параметрах можно указать собственную ширину столбцов отчета
Например: 7,14.5,12,12,12,8,17
Число параметров должно быть строго 7 !!!
- Вызов : По требованию
4.Способ применения:
В верхнем окне заголовков списков нажимаем CTRL_F5 и запускаем настроенное по п.3 решение.
 
Код
#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
 
Спасибо! Очень актуальный плагин. Но есть и немного дегтя..
1. Номер лицевого счета из 20 цифр представляется числом в экспоненциальной форме => нет форматирования
2. Не заполняются поля Фамилия, Имя , Отчество => отсутствует связь с CARDSPRI ?
3. Неверно отражается сумма => требуется форматирование колонки?

Вот если б это заработало :nowords:
 
Замечания принимаются без проблем
1.У меня работает на моей демобазе с фамилией,именем,отчеством.
2.ФОрматирование колонок добавить это не проблема, давайте поправлю
3.Сумма у меня тоже нормально отображается.
Есть подозрение что для разных Excel надо подгонку делать.
Исходный текст я разместил, могу подсказать как прямо в нем поправить.
 
По поводу связи с cardspri я не стал время тратить на установку индексных ключей, потому как у меня в демобазе он итак стоит с нужным индексом.
Я все тестирую на 53 пакете - посмотрите по ALT_INS на cardspri у вас и на его текущий индексный ключ в этой точке программы.
 
Задача с форматом стобцов была вылечена следующими исправлениями.
1.В массиве aWide при объявлении поставлены такие значения:
Код
{5,24,11,11,11,10,10}

2.В раздел "столбцы" в самый конец добавил 2 строчки
Код
oAS:columns("B:B"):Rows:NumberFormat = "@"
 oAS:columns("F:F"):Rows:NumberFormat:=REPLICATE("#",10)+"0"+cDecSep+REPLICATE("0",2)


Исправленый исходный текст и откомпилированную версию сейчас перевыложу
 
Форматирование мы победили :super:
А вот с фамилиями пока никак.. посмотрю, что у меня с индексами (SP54)
Посмотрел.. у меня CARDSPRI индексирован по TNUM
Изменено: Михаил Михайлов - 15.07.2009 17:23:14
 
И у меня такой же индексный ключ. Так что от пакета это не зависит.
И по исходному коду как видите он ищет....
У меня фамилия прекрасно передаются, на чем искать проблему не вижу....
Могу только этот файл предложить открыть заново и сделать по нему поиск.
Но думаю что у вас будет тоже самое.
 
Я вот все думаю про Фамилию.....
Сделайте пожалуйста вот что:
через ALT_INS
Посмотрите на значения полей OCODE в таблице RECTRANC
Сраните их с TNUM в CARDSPRI - совпадут ?

Еще Вопрос - Вы можете мой исходный код у себя откомпилировать у себя с отладчиком ?
 
Цитата
nordk пишет:
Посмотрите на значения полей OCODE в таблице RECTRANC
Сраните их с TNUM в CARDSPRI - совпадут ?


Нет, конечно! В реале трудно представить ситуацию, когда номер в списке совпадает с табельным номером. Хотя.. вероятно в этом что-то есть..
Может быть стоит использовать поле TNUM вместо OCODE?

Цитата
nordk пишет:
Еще Вопрос - Вы можете мой исходный код у себя откомпилировать у себя с отладчиком ?

Для этого нужно будет добраться до ПК с БЭСТом. Сейчас это невозможно
Изменено: Михаил Михайлов - 16.07.2009 11:27:05
 
Цитата
nordk пишет:
Нет, конечно! В реале трудно представить ситуацию, когда номер в списке совпадает с табельным номером. Хотя.. вероятно в этом что-то есть..
Может быть стоит использовать поле TNUM вместо OCODE?

Конечно Вы правы - это я затупил.....
Провозился с вопросом намного больше намеченного - и вот результат от того-что поторопился. Сейчас поправлю
 
Исправил поиск по RECTRANC->TNUM и перевыложил.
Спасибо за помощь в тестировании задачи !!!
 
Да, у меня тоже после компиляции сработало как надо :smile:
 
Скажите,пожалуйста,может вы знаете по какой причине при "В верхнем окне заголовков списков нажимаем CTRL_F5 и запускаем настроенное" я сразу вылетаю на меню АРМов, и никакой выгрузки в Excel не происходит.Причем дома у меня стоит БЭСТ в демо режиме и там все прекрасно работает.
 
Посмотрите плз у вас файл Error.log создается ?
 
нет, не создается.Просто вылетает.
 
А в оперативной памяти не висят незакрытые приложения Excel ?
 
Лично у меня закрыты все приложения, но может дело в том, что Бэст работает в терминальном режиме, соответственно чьи-нибудь незакрытые приложения Excel на Citrix висят.
 
Нет, Вы не поняли.
Решение открывает Excel и работает с ним.
А только в самом конце делает его для Вас видимым.
Т.е. всякий раз когда решение не выполнилось до конца может быть открыта страница Excel для Вас не видимая и их можно уидеть только в закладке "Процессы" в диспетчере задач Windows.
А еще если Вы терминальном режиме и у Вас сервер 2003 - он просто может не давать стартовать Вам любые плагины из БЭСТа. Что-то такое уже было на памяти - то ли надо в Dep прописать, то ли еще что-то может блокироваться - посмотрите на техническом форуме. Вроде такой уже был Вопрос.
Т.е. дело не в базе и не в решении, а в настройке сервера может быть.
 
Попробуйте на сервер harbour.exe внести в список DEP
Страницы: 1
Читают тему (гостей: 1)