Галактика в вопросах и ответах

Обсуждение различных вопросов, связанных с сопровождением, администрированием и программированием
https://ns1.tyumbit.ru/

Можно ли загрузить данные из файла .xls в Галактику?

https://ns1.tyumbit.ru/viewtopic.php?t=5397

Страница 2 из 2

Добавлено: 07 дек 2009, 16:29
edward_K
да. и формат не выше dbase4(для старых версий галки dbase3)

Добавлено: 07 дек 2009, 17:40
lStep
Можно ли загрузить данные из файла .xls в Галактику?
Еслив можно то как енто делается?
Если таблица одна, то зачем такие сложности?:
в модуле SQL есть великолептая комманда import

import oborot from dbf D:\oborot.dbf fsnr; параметры найдёте

А Если таблиц несколько и она связаны и "загрузить данные" это интерфейс для частого использование и/или для пользователя, то: открываем, читаем, :shock: ковыряем, закрываем. И в сравнении с ковыряем выбор между DBFGetFieldValue и xlGetCellValue просто несущественен. Любая вам поможет. :cool:

Добавлено: 07 дек 2009, 17:51
lStep
про работе с DBFGetFieldValue (аккуратней с датами)

Код: Выделить всё

File XFile;

VAR IIII: LONGiNT;

Function FileExist (pFName: string): boolean;
{
  _try
  { 
    xFile.OpenFile (pFName, stOpen); 
    FileExist:=True;
  };
  _except 
  on ExFileNotFound:
     { 
    //  Message('!!!! Нет Файла',Yes)
       FileExist:=False;
     }; 
  _finally  xFile.Close;
}  // FileExist (pFName: string);

function DBFOpen2 (pName : String; pMode : Integer) : LongInt;
{
  DBFOpen2 := 0;
  if FileExist(pName) then DBFOpen2 := DBFOpen(pName,pMode);
}

FUNCTION dBF_DATE(DD:LongInt;D:STRING):DATE;
{
  VAR  SV:STRING;  
  var pDD : date;
  SV:=DBFGetFieldValue(DD,D);
//  dBF_DATE:=DATE(SUBSTR(SV,7,2),SUBSTR(SV,5,2),SUBSTR(SV,1,4));
//  dBF_DATE:=StrToDATE(SV, 'DD/MM/YYYY');

  INC(IIII);
  pDD := DATE(SUBSTR(SV,1,2),SUBSTR(SV,4,2),SUBSTR(SV,7,4));
//  IF IIII < 10 THEN lOGsTRtOfILE ('U:\DataFromXL\LoadDBF3.log','SV=' + SV + 'dBF_DATE =' + pDD);
  dBF_DATE := pDD;
}

Procedure LoadDBF(pStrDBFfile: string);
{
IIII := 0;  
  var j:word;
  var l_DBFfile:LongInt;
  var CountErZ,AllCount  : LongInt;
      var       BadCount : LongInt;

  l_DBFfile:=DBFOpen2(pStrDBFfile,stOpenRead);
  if l_DBFfile=0 then
  {
               mESSAGE('Ошибка открытия файла тел документов :'+DBFfile);
      stop; exit;
  }

  AllCount :=0;  BadCount :=0;

  if DBFGetFirst(l_DBFfile)=tsOK
  {

     do 
     {
       inc(AllCount);

       if tsOk <>
          insert MTDataIn set 
                 MTDataIn.KodErr    := word   ( DBFGetFieldValue(l_DBFfile,'KODERR' )) , 
                 MTDataIn.StrErr    :=    TRIM( DBFGetFieldValue(l_DBFfile,'STRERR' )) , 
                 MTDataIn.Stage     := word   ( DBFGetFieldValue(l_DBFfile,'STAGE'  )) , 
                 MTDataIn.Line      := LongInt( DBFGetFieldValue(l_DBFfile,'LINE'   )) , 
                 MTDataIn.cSt       := comp   ( DBFGetFieldValue(l_DBFfile,'CST'    )) , 
                 MTDataIn.StKod     :=    TRIM( DBFGetFieldValue(l_DBFfile,'STKOD'  )) , 
                 MTDataIn.StName    :=    TRIM( DBFGetFieldValue(l_DBFfile,'STNAME' )) , 
                 MTDataIn.cCO       := comp   ( DBFGetFieldValue(l_DBFfile,'CCO'    )) , 
                 MTDataIn.COKod     :=    TRIM( DBFGetFieldValue(l_DBFfile,'COKOD'  )) , 
                 MTDataIn.CoName    :=    TRIM( DBFGetFieldValue(l_DBFfile,'CONAME' )) , 
                 MTDataIn.cMVZ      := comp   ( DBFGetFieldValue(l_DBFfile,'CMVZ'   )) , 
                 MTDataIn.MvzKod    :=    TRIM( DBFGetFieldValue(l_DBFfile,'MVZKOD' )) , 
                 MTDataIn.MvzName   :=    TRIM( DBFGetFieldValue(l_DBFfile,'MVZNAME')) , 
                 MTDataIn.cPRJ      := comp   ( DBFGetFieldValue(l_DBFfile,'CPRJ'   )) , 
                 MTDataIn.PrjKod    :=    TRIM( DBFGetFieldValue(l_DBFfile,'PRJKOD' )) , 
                 MTDataIn.PrjName   :=    TRIM( DBFGetFieldValue(l_DBFfile,'PRJNAME')) , 
                 MTDataIn.Plant     :=    TRIM( DBFGetFieldValue(l_DBFfile,'PLANT'  )) , 
                 MTDataIn.YPlan     := Double ( DBFGetFieldValue(l_DBFfile,'YPLAN'  )) , 
                 MTDataIn.MM        := word   ( DBFGetFieldValue(l_DBFfile,'MM'     )) , 
                 MTDataIn.cPeriod   := Comp   ( DBFGetFieldValue(l_DBFfile,'CPERIOD')) , 
                 MTDataIn.cRec      := Comp   ( DBFGetFieldValue(l_DBFfile,'CREC'   )) , 
                 MTDataIn.Ddoc      :=                  dBF_DATE(l_DBFfile,'DDOC'   )  , 
                 MTDataIn.BudName   :=    TRIM( DBFGetFieldValue(l_DBFfile,'BUDNAME')) , 
                 MTDataIn.MPlan     :=    TRIM( DBFGetFieldValue(l_DBFfile,'MPLAN'  )) , 
                 MTDataIn.MName     :=    TRIM( DBFGetFieldValue(l_DBFfile,'MNAME'  )) , 
                 MTDataIn.Summa     := double ( DBFGetFieldValue(l_DBFfile,'SUMMA'  )) 
         then 
         {
           message('Ошибка Загрузки. Запись N '+string(AllCount))
           inc(BadCount);
         }
     }
     while DBFGetNext(l_DBFfile)=tsOK
  }

  Message('Обработано записей: '+string(AllCount) + ''#13+'          Закачено: '+string(AllCount-BadCount));
DBFClose(l_DBFfile);

}

Добавлено: 07 дек 2009, 19:37
Ged

Код: Выделить всё

FUNCTION dBF_DATE(DD:LongInt;D:STRING):DATE;
можно и
StrToDate(dbfD,'YYYYMMDD')

Добавлено: 07 дек 2009, 20:16
edward_K
А Если таблиц несколько и она связаны
если разово, можно ссылки подтягивать и в excel(я молчу про visual fox) - ВПР(?????;??????;ЛОЖЬ)

Добавлено: 09 дек 2009, 13:30
ramil
Пример работы с excel в vip
Самописный фейс "Импорт цен МЦ в прайс-лист из Excel"

/*
║ Назначение : Импорт цен МЦ из прайс-листа Excel
║ Параметры : нет
*/

Interface Int_ImpPriceFromExcel 'Импорт цен МЦ в прайс-лист из Excel';
show at (0,0,65,14);
create view
var
XlRes : boolean;
sKlPriceName : string;
sKlPriceNameKomm : string
cKlPriceNrec : comp;
sExcelFileName : string; //путь к оригинальному файлу
sEFN_Copy : string; //временная копия файла
iExcelListName : integer;
sExcelCol_KodBS : integer;
sExcelCol_Price : integer;
sExcelRow_Beg : longint;
sExcelRow_End : longint;
sExcelRow_EdIzm : longint;
str01 : string;
str02 : string;
Count_Ins : longint;
Count_Upd : longint;
Count_Err : longint;
as select * from KatEd;
//ПРАЙС-ЛИСТЫ//ПРАЙС-ЛИСТЫ//ПРАЙС-ЛИСТЫ//ПРАЙС-ЛИСТЫ//ПРАЙС-ЛИСТЫ//ПРАЙС-ЛИСТЫ
//ПРАЙС-ЛИСТЫ//ПРАЙС-ЛИСТЫ//ПРАЙС-ЛИСТЫ//ПРАЙС-ЛИСТЫ//ПРАЙС-ЛИСТЫ//ПРАЙС-ЛИСТЫ
//ПРАЙС-ЛИСТЫ//ПРАЙС-ЛИСТЫ//ПРАЙС-ЛИСТЫ//ПРАЙС-ЛИСТЫ//ПРАЙС-ЛИСТЫ//ПРАЙС-ЛИСТЫ
create view vwKlPrice999
var
cComp999 : comp
as select *
from KlPrice(ReadOnly)
where KlPrice.nRec=cComp999
;
create view vwPrice111 //выгрузка ВСЕГО прайс-листа
var
cComp111 : comp
as select *
from KlPrice (ReadOnly), PRICES, KatOtpEd (ReadOnly), KatMC (ReadOnly), KatEd (ReadOnly)
where
((
KlPrice.nRec /== PRICES.CKLPRICE
and PRICES.COTPED /== KatOtpEd.nRec
and PRICES.CTHING /== KatMC.nRec
and KatMC.CED /== KatEd.nRec
))
and KlPrice.nRec=cComp111
;
create view vwPrice222 //выгрузка только одной МЦ в прайс-листе
var
vwPrice222_c1 : comp
vwPrice222_c2 : comp
as select *
from KlPrice (ReadOnly), PRICES, KatOtpEd (ReadOnly), KatMC (ReadOnly), KatEd (ReadOnly)
where
((
KlPrice.nRec /== PRICES.CKLPRICE
and PRICES.COTPED /== KatOtpEd.nRec
and PRICES.CTHING /== KatMC.nRec
and KatMC.CED /== KatEd.nRec
))
and KlPrice.nRec =vwPrice222_c1
and PRICES.CTHING=vwPrice222_c2
;
//KATMC==KATOTPED//KATMC==KATOTPED////KATMC==KATOTPED////KATMC==KATOTPED//
//KATMC==KATOTPED//KATMC==KATOTPED////KATMC==KATOTPED////KATMC==KATOTPED//
//KATMC==KATOTPED//KATMC==KATOTPED////KATMC==KATOTPED////KATMC==KATOTPED//
create view vwMCOtpEd888 //нахождение отпускных единиц
var
cComp888 : comp //МЦ
as select *
from KatMC (ReadOnly), KatOtpEd (ReadOnly)
where
((
KatMC.nRec /== KatOtpEd.CMCUSL
))
and KatMC.nRec =cComp888
and KatOtpEd.prmc=word(1)
;
create view vwMCOtpEd891 //нахождение АКТИВНОЙ отпускной единицы
var
cComp891 : comp //МЦ
as select *
from KatMC (ReadOnly), KatOtpEd (ReadOnly)
where
((
KatMC.nRec /== KatOtpEd.CMCUSL
))
and KatMC.nRec =cComp891
and KatOtpEd.prmc=word(1)
and KatOtpEd.akt =word(1)
;
create view vwMCOtpEd892 //нахождение УЧЕТНОЙ отпускной единицы
var
cComp892 : comp //МЦ
as select *
from KatMC (ReadOnly), KatOtpEd (ReadOnly)
where
((
KatMC.nRec /== KatOtpEd.CMCUSL
))
and KatMC.nRec =cComp892
and KatOtpEd.prmc=word(1)
and KatOtpEd.Koef=1
;
create view vwKatMCAttr //выгрузка всех МЦ с внешним атрибутом
var
vwKatMCAttr_AttrName : string
vwKatMCAttr_AttrWTable : word
as select *
from AttrVal, KatMc
where
((
Root == AttrNam.nRec
and AttrNam.nRec /== AttrVal.cAttrNam
and AttrVal.cRec /== KatMc.nrec
))
and AttrNam.Name = vwKatMCAttr_AttrName
and AttrNam.wTable = vwKatMCAttr_AttrWTable
;
//ВРЕМЕННЫЕ ТАБЛЫ//ВРЕМЕННЫЕ ТАБЛЫ//ВРЕМЕННЫЕ ТАБЛЫ//ВРЕМЕННЫЕ ТАБЛЫ
//ВРЕМЕННЫЕ ТАБЛЫ//ВРЕМЕННЫЕ ТАБЛЫ//ВРЕМЕННЫЕ ТАБЛЫ//ВРЕМЕННЫЕ ТАБЛЫ
//ВРЕМЕННЫЕ ТАБЛЫ//ВРЕМЕННЫЕ ТАБЛЫ//ВРЕМЕННЫЕ ТАБЛЫ//ВРЕМЕННЫЕ ТАБЛЫ
Table struct mDataExcel //для хранения данных книги Excel
(
nRec : comp,
MCKodBS : string,
MCName : string,
MCPrice : string
)
with index
(
mDataExcel_ind01=nrec(unique,surrogate),
mDataExcel_ind02=MCKodBS
)
;
Table struct mDataMC //для хранения каталога МЦ со значением атрибута
(
nRec : comp,
MCnrec : comp,
MCAttr : string
)
with index
(
mDataMC_ind01=nrec(unique,surrogate),
mDataMC_ind02=MCnrec(unique),
mDataMC_ind03=MCAttr
)
;
//──────────────────────────────────────────────────────────────────────────────
!!!Parameters
!!!Form PlPorList ( 'LogImpPriceExcel.out' ) with NoVisual;
Form PlPorList ( 'LogImpPriceExcel.out' ) with NoVisual;
//──────────────────────────────────────────────────────────────────────────────
Procedure myWrite( myWriteStroka:string );
begin
Count_Err:=Count_Err+1;
PlPorList.Write( myWriteStroka );
end;
//──────────────────────────────────────────────────────────────────────────────
Screen scr_Int_ImpPriceFromExcel;
Fields
str01 : Protect, Skip, {Font = {BOLD = true}};
sKlPriceName : Protect, PickButton;
sKlPriceNameKomm : Protect, Skip;
str02 : Protect, Skip, {Font = {BOLD = true}};
sExcelFileName : Protect, PickButton;
iExcelListName : [List 1 ' '], Protect;
sExcelCol_kodBS : [List 1 ' '], Protect; sExcelRow_beg : NoProtect;
sExcelCol_price : [List 1 ' '], Protect; sExcelRow_end : NoProtect;
sExcelRow_EdIzm : [List 1 'Учетные', 2 'Отпускные(активные)'];
Buttons
cmPusk, Default;
cmCancel1;
<<
!!! Выберите прайс-лист:
.@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
.@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
.@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

!!! Укажите прайс-лист Excel для импорта данных:
.@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
.@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Укажите Лист с данными:.@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Задайте столбцы: Задайте диапазон строк:
"Код МЦ из атр." .@@@@@@@@@@@@@@@@@@ Начальная строка .@@@@@@@@
"Цена за ед.изм.".@@@@@@@@@@@@@@@@@@ Конечная строка .@@@@@@@@
Ед.изм. в прайсе .@@@@@@@@@@@@@@@@@@

<. Запустить импортирование .> <. Отмена .>

>>
end;
//──────────────────────────────────────────────────────────────────────────────
!!!// Функция определяет строковое представление столбца по номеру
Function myGetColStrPre( l_myGetColStrPre : longint ) : string;
var
s_abc : string;
l_abc : longint;
l_123 : longint;
i_123 : longint;
kod1, kod2 : longint;
begin
myGetColStrPre:='';

l_123:=l_myGetColStrPre;
s_abc:='ABCDEFGHIJKLMNOPQRSTUVWXYZ';
l_abc:=length(s_abc);

kod1:=Longint( Trunc((l_123-1)/l_abc) ); //1-й символ номера столбца
kod2:=Longint( l_123-kod1*l_abc ); //2-й символ номера столбца
if Kod1=0 Then myGetColStrPre:=SubStr(s_abc,kod2,1)
Else myGetColStrPre:=SubStr(s_abc,Kod1,1)+SubStr(s_abc,Kod2,1);

end;
//──────────────────────────────────────────────────────────────────────────────
!!!// Функция определяет имя файла по его пути
Function myGetOnlyFileName( s_myGetOnlyFileName : string) : string;
var
i_myGetOnlyFileName : longint;
begin
myGetOnlyFileName:='';

i_myGetOnlyFileName:=0;
while ( inStr(Chr(92), SubStr(s_myGetOnlyFileName,i_myGetOnlyFileName+1,length(s_myGetOnlyFileName)))>0 ) do
begin
i_myGetOnlyFileName:=i_myGetOnlyFileName+inStr(Chr(92), SubStr(s_myGetOnlyFileName,i_myGetOnlyFileName+1,length(s_myGetOnlyFileName)));
end;

myGetOnlyFileName:=SubStr( s_myGetOnlyFileName, i_myGetOnlyFileName+1, length(s_myGetOnlyFileName) );
end;
//──────────────────────────────────────────────────────────────────────────────
!!!// Сохраняем настройки
Procedure SaveDsk;
begin
SaveMyDsk( sExcelCol_kodBS,'Int_ImpPriceFromExcel_sExcelCol_kodBS');
SaveMyDsk( sExcelCol_Price,'Int_ImpPriceFromExcel_sExcelCol_Price');
SaveMyDsk( sExcelRow_EdIzm,'Int_ImpPriceFromExcel_sExcelRow_EdIzm');
SaveMyDsk( sExcelRow_beg,'Int_ImpPriceFromExcel_sExcelRow_beg');
SaveMyDsk( sExcelRow_end,'Int_ImpPriceFromExcel_sExcelRow_end');
end;
//──────────────────────────────────────────────────────────────────────────────
!!!// Загружаем настройки
Procedure ReadDsk;
var
DateChanged:boolean;
begin
DateChanged:=False;

if (not ReadMyDsk( sExcelCol_kodBS,'Int_ImpPriceFromExcel_sExcelCol_kodBS',DateChanged))
sExcelCol_kodBS:=1;
set sExcelCol_kodBS:=sExcelCol_kodBS;

if (not ReadMyDsk( sExcelCol_Price,'Int_ImpPriceFromExcel_sExcelCol_Price',DateChanged))
sExcelCol_Price:=1;
set sExcelCol_Price:=sExcelCol_Price;

if (not ReadMyDsk( sExcelRow_EdIzm,'Int_ImpPriceFromExcel_sExcelRow_EdIzm',DateChanged))
sExcelRow_EdIzm:=2;
set sExcelRow_EdIzm:=sExcelRow_EdIzm;

if (not ReadMyDsk( sExcelRow_beg,'Int_ImpPriceFromExcel_sExcelRow_beg',DateChanged))
sExcelRow_beg:=1;
set sExcelRow_beg:=sExcelRow_beg;

if (not ReadMyDsk( sExcelRow_end,'Int_ImpPriceFromExcel_sExcelRow_end',DateChanged))
sExcelRow_end:=1000;
set sExcelRow_end:=sExcelRow_end;

end;
//──────────────────────────────────────────────────────────────────────────────
!!!// заполнение iExcelListName - НАИМЕНОВАНИЙ ЛИСТОВ в книге
Procedure See_iExcelListName (var Rez_See_iExcelListName : boolean);
begin
Rez_See_iExcelListName:=False;

//сначала копируем файл источник в tmp...
sEFN_Copy:=GetPathParameter('Files','TmpFilesDirectory',0)+'tmp'+DateToStr(Cur_Date,'YYMMDD')+TimeToStr(Cur_Time,'HHMMSS')+myGetOnlyFileName(sExcelFileName);
if (Not CopyMoveFile(sExcelFileName,sEFN_Copy, false)) then Message('Ошибка! CopyMoveFile');



var m1 : array [1..2] of string;
var m2 : array [1..2] of integer;
var mi, miN : integer;
SetLimit(m1, 0);
SetLimit(m2, 0);
SetEnumList(scr_Int_ImpPriceFromExcel, #iExcelListName, m1, m2); // screen scr_Int_ImpPriceFromExcel
mi:=0; miN:=0;

//работаем с EXCEL
if (NOT xlIsExcelValid) then if (NOT xlOpenExcel(False)) then begin Message('Ошибка! xlOpenExcel'); break; end; //открываем excel
if (NOT xlDISPLAYALERTS(False) ) then begin Message('Ошибка! xlDisplayAlerts'); break; end; //убираем сообщения в EXCEL
if (NOT xlOpenWorkBook(sEFN_Copy)) then begin Message('Ошибка! xlOpenWorkBook'); break; end; //открываем книгу
if (NOT xlSetActiveWorkBookByName(sEFN_Copy)) then begin Message('Ошибка! xlSetActiveWorkBookByName'); break; end; //устанавливаем активную книгу

mi:=1;
if (NOT xlGetSheetsCount(miN)) then begin Message('Ошибка! xlGetSheetsCount'); break; end;
for(mi:=1;mi<=miN;mi:=mi+1)
begin
m2[mi]:=mi;
if (NOT xlGetSheetName(mi,m1[mi])) then begin Message('Ошибка! xlGetSheetName'); break; end;
end;

SetEnumList(scr_Int_ImpPriceFromExcel, #iExcelListName, m1, m2); // screen scr_Int_ImpPriceFromExcel
set iExcelListName := 1;

if (NOT xlCloseWorkBookByName(sEFN_Copy)) then begin Message('Ошибка! xlCloseWorkBookByName'); break; end; //закрываем открытую нами книгу
if (NOT xlKillExcel) then begin Message('Ошибка! xlKillExcel'); break; end; //закрываем Excel



//удаляем временный файл
if (NOT DeleteFile(sEFN_Copy)) then Message('Ошибка! DeleteFile');

Rez_See_iExcelListName:=True;
end;
//──────────────────────────────────────────────────────────────────────────────
!!!// Заполнение mDataExcel данными из прайс-листа Excel
Procedure Get_Price_From_Excel;
var
RowU : longint;
ColL : longint;
RowD : longint;
ColR : longint;
RowsCount : longint;
ColsCount : longint;
i : longint;
begin
StartNewVisual(vtRotateVisual ,vfTimer,'Обработка файла Excel',50);

//сначала копируем файл источник в tmp...
sEFN_Copy:=GetPathParameter('Files','TmpFilesDirectory',0)+'tmp'+DateToStr(Cur_Date,'YYMMDD')+TimeToStr(Cur_Time,'HHMMSS')+myGetOnlyFileName(sExcelFileName);
if (Not CopyMoveFile(sExcelFileName,sEFN_Copy, false)) then Message('Ошибка! CopyMoveFile');



delete all from mDataExcel;

RowU := sExcelRow_beg;
ColL := sExcelCol_kodBS;
RowD := sExcelRow_end;
ColR := sExcelCol_price;

//работаем с Excel
if (NOT xlIsExcelValid) then if (NOT xlOpenExcel(False)) then Message('Ошибка! xlOpenExcel'); //открываем EXCEL
if (NOT xlDISPLAYALERTS(False) ) then Message('Ошибка! xlDisplayAlerts'); //убираем сообщения в EXCEL
if (NOT xlOpenWorkBook(sEFN_Copy)) then Message('Ошибка! xlOpenWorkBook'); //открываем книгу
if (NOT xlSetActiveWorkBookByName(sEFN_Copy)) then Message('Ошибка! xlSetActiveWorkBookByName'); //устанавливаем активную книгу
if (NOT xlSetActiveSheet(iExcelListName)) then Message('Ошибка! xlSetActiveSheet'); //устанавливаем активный лист
if (NOT xlReadMatrixFromExcel(RowU, ColL, RowD, ColR)) then Message('Ошибка! xlReadMatrixFromExcel'); //читаем данные в массив
RowsCount := longint(abs(RowD - RowU)+1);
ColsCount := longint(abs(ColR - ColL)+1);
if ColL<ColR then //находим номера столбцов в массиве данных
begin
ColL:=1;
ColR:=ColsCount;
end
else
begin
ColL:=ColsCount;
ColR:=1;
end;

//................................
for(i:=1; i<=RowsCount; i:=i+1) //переносим данные в mDataExcel
begin
mDataExcel.nrec:=comp(0);

if (NOT xlReadFromMatrix(i,ColL,mDataExcel.MCKodBS)) then Message('Ошибка! xlReadFromMatrix');
mDataExcel.MCKodBS:=Trim(mDataExcel.MCKodBS);
mDataExcel.MCKodBS:=Replace(mDataExcel.MCKodBS,Chr(32),'');

mDataExcel.MCName:='';

if (NOT xlReadFromMatrix(i,ColR,mDataExcel.MCPrice)) then Message('Ошибка! xlReadFromMatrix');
mDataExcel.MCPrice:=Trim(mDataExcel.MCPrice);
mDataExcel.MCPrice:=Replace(mDataExcel.MCPrice,Chr(32),'');
mDataExcel.MCPrice:=Replace(mDataExcel.MCPrice,Chr(44),Chr(46));

//if (Trim(mDataExcel.MCKodBS)<>'' AND Double(mDataExcel.MCPrice)<>0) then insert current mDataExcel;
if (Trim(mDataExcel.MCKodBS)<>'') then insert current mDataExcel; //пропуск только если нет кода БС(цена м.б. нулевой)
end;

//проверка... if (GetFirst mDataExcel = tsok) then do Message(mDataExcel.MCKodBS+Chr(13)+mDataExcel.MCPrice+Chr(13)+Double(mDataExcel.MCPrice)); while (GetNext mDataExcel = tsok);
//................................

if (NOT xlCloseWorkBookByName(sEFN_Copy)) then Message('Ошибка! xlCloseWorkBookByName'); //закрываем открытую нами книгу
if (NOT xlKillExcel) then Message('Ошибка! xlKillExcel'); //закрываем Excel



//удаляем временный файл
//!!!удалять не будем чтобы видеть историю!!!// if (NOT DeleteFile(sEFN_Copy)) then Message('Ошибка! DeleteFile');

stopvisual('',0);
end;
//──────────────────────────────────────────────────────────────────────────────
!!!// Заполнение mDataMC данными из каталога МЦ + внешние атрибуты
Procedure Get_MC_From_KatMC;
begin
StartNewVisual(vtRotateVisual ,vfTimer,'Просмотр каталога МЦ',50);

delete all from mDataMC;

vwKatMCAttr.vwKatMCAttr_AttrName :='Код БС';
vwKatMCAttr.vwKatMCAttr_AttrWTable:=word(1411);
if (vwKatMCAttr.GetFirst=tsOk) then
begin
do
{
iNextVisual('Просмотр каталога МЦ');
mDataMC.nRec :=comp(0);
mDataMC.MCnRec:=vwKatMCAttr.KatMC.nRec;
mDataMC.MCAttr:=vwKatMCAttr.AttrVal.Vstring;
if (Trim(vwKatMCAttr.AttrVal.Vstring)<>'') then insert current mDataMC;
} while (vwKatMCAttr.GetNext=tsOk);
end;

stopvisual('',0);
end;
//──────────────────────────────────────────────────────────────────────────────
!!!// Запуск процесса импорта данных
Procedure Call_ImportProcess;
begin
StartNewVisual(vtRotateVisual ,vfTimer,'Импортирование прайс-листа',50);

var dCena : double;

vwKlPrice999.cComp999:=cKlPriceNrec;
if vwKlPrice999.GetFirst=tsOk then begin end;


if (GetFirst mDataExcel)=tsok then //бежим по данным прайса Excel
do
{
iNextVisual('Импортирование прайс-листа');

dCena:=0;
if (Getfirst mDataMC where mDataMC.mcAttr=mDataExcel.MCKodBS)=tsok then //ищем МЦ по коду
begin

vwPrice222.vwPrice222_c1:=cKlPriceNrec; //прайс-лист
vwPrice222.vwPrice222_c2:=mDataMC.mcnrec; //спецификация прайса-фильтр по МЦ
if vwPrice222.GetFirst=tsok then
begin//МЦ есть в прайсе, ДЕЛАЕМ ОБНОВЛЕНИЕ ПРАЙСА...
do
{

dCena:=0;
vwMCOtpEd888.cComp888:=mDataMC.MCnrec;
if vwMCOtpEd888.GetFirst=tsOk then
begin
do
{
if vwPrice222.Prices.cOtpEd=vwMCOtpEd888.KatOtpEd.nRec then
begin

case vwMCOtpEd888.KatOtpEd.Koef of
1 : { //если учетная единица измерения
if sExcelRow_EdIzm=1 then dCena:=Double(mDataExcel.MCPrice);
if sExcelRow_EdIzm=2 then
begin
vwMCOtpEd891.cComp891:=mDataMC.MCnrec; //акт отп ед
if vwMCOtpEd891.GetFirst=tsOk then
dCena:=Double(mDataExcel.MCPrice)*(vwMCOtpEd888.KatOtpEd.Koef/vwMCOtpEd891.KatOtpEd.Koef);
end;
}
else { //если не учетная единица измерения
if vwMCOtpEd888.KatOtpEd.Akt=1 then //(обрабатываем только активные отп ед)
begin
if sExcelRow_EdIzm=2 then dCena:=Double(mDataExcel.MCPrice);
if sExcelRow_EdIzm=1 then
begin
vwMCOtpEd892.cComp892:=mDataMC.MCnrec; //учетная отп ед
if vwMCOtpEd892.GetFirst=tsOk then
dCena:=Double(mDataExcel.MCPrice)*(vwMCOtpEd888.KatOtpEd.Koef/vwMCOtpEd892.KatOtpEd.Koef);
end;
end;
}
end; //конец case
vwPrice222.Prices.Price:=dCena;
vwPrice222.update current Prices;
Count_Upd:=Count_Upd+1;

end;
} while (vwMCOtpEd888.GetNext=tsOk and dCena=0);
end;

} while (vwPrice222.GetNext=tsok);
end
else
begin //МЦ нет прайсе, делаем ДОБАВЛЕНИЕ В ПРАЙС

dCena:=0;
if sExcelRow_EdIzm=1 then //прайс-лист в учетных ценах
begin
dCena:=Double(mDataExcel.MCPrice);
vwMCOtpEd892.cComp892:=mDataMC.MCnrec; //учетная отп ед
if vwMCOtpEd892.GetFirst=tsOk then
begin
//ClearBuffer(vwPrice222.Prices);
vwPrice222.Prices.nRec :=comp(0);
vwPrice222.Prices.CKLPRICE :=vwKlPrice999.KlPrice.Nrec;
vwPrice222.Prices.CTHING :=vwMCOtpEd892.KatMc.nrec;
vwPrice222.Prices.TIP :=vwKlPrice999.KlPrice.Tip;
vwPrice222.Prices.NAME :=vwMCOtpEd892.KatMc.Name;
vwPrice222.Prices.BARKOD :=vwMCOtpEd892.KatMc.BarKod;
vwPrice222.Prices.BAROTP :=vwMCOtpEd892.KatOtpEd.BKod;
vwPrice222.Prices.DISKRET :=vwMCOtpEd892.KatOtpEd.Diskret;
vwPrice222.Prices.PRICE :=dCena;
vwPrice222.Prices.CVAL :=0;
vwPrice222.Prices.SUMVAL :=0;
vwPrice222.Prices.DFORM :=Cur_Date;
vwPrice222.Prices.PRAVT :=0;
vwPrice222.Prices.COTPED :=vwMCOtpEd892.KatOtpEd.Nrec;
vwPrice222.Prices.GARANT :=0;
vwPrice222.Prices.DOPHAR :='';
vwPrice222.Prices.CGROUPMC :=vwMCOtpEd892.KatMc.cGroupMC;
vwPrice222.Prices.KOD :=vwMCOtpEd892.KatMc.kGroupMC;
vwPrice222.Prices.PRSORT :=0;
vwPrice222.Prices.CPARTY :=0;
vwPrice222.Prices.NPARTY :='';
vwPrice222.Prices.SRPRICE :=0;
vwPrice222.Prices.SRVPRICE :=0;
vwPrice222.Prices.ZPRICE :=0;
vwPrice222.Prices.ZVPRICE :=0;
vwPrice222.Prices.CGRUSL :=0;
vwPrice222.Prices.ONZAVPRICE:=False;
vwPrice222.insert current Prices;
Count_Ins:=Count_Ins+1;
end;
end;
dCena:=0;
if sExcelRow_EdIzm=2 then //прайс-лист в акт отп ед
begin
dCena:=Double(mDataExcel.MCPrice);
vwMCOtpEd891.cComp891:=mDataMC.MCnrec; //акт отп ед
if vwMCOtpEd891.GetFirst=tsOk then
begin
//ClearBuffer(vwPrice222.Prices);
vwPrice222.Prices.nRec :=comp(0);
vwPrice222.Prices.CKLPRICE :=vwKlPrice999.KlPrice.Nrec;
vwPrice222.Prices.CTHING :=vwMCOtpEd891.KatMc.nrec;
vwPrice222.Prices.TIP :=vwKlPrice999.KlPrice.Tip;
vwPrice222.Prices.NAME :=vwMCOtpEd891.KatMc.Name;
vwPrice222.Prices.BARKOD :=vwMCOtpEd891.KatMc.BarKod;
vwPrice222.Prices.BAROTP :=vwMCOtpEd891.KatOtpEd.BKod;
vwPrice222.Prices.DISKRET :=vwMCOtpEd891.KatOtpEd.Diskret;
vwPrice222.Prices.PRICE :=dCena;
vwPrice222.Prices.CVAL :=0;
vwPrice222.Prices.SUMVAL :=0;
vwPrice222.Prices.DFORM :=Cur_Date;
vwPrice222.Prices.PRAVT :=0;
vwPrice222.Prices.COTPED :=vwMCOtpEd891.KatOtpEd.Nrec;
vwPrice222.Prices.GARANT :=0;
vwPrice222.Prices.DOPHAR :='';
vwPrice222.Prices.CGROUPMC :=vwMCOtpEd891.KatMc.cGroupMC;
vwPrice222.Prices.KOD :=vwMCOtpEd891.KatMc.kGroupMC;
vwPrice222.Prices.PRSORT :=0;
vwPrice222.Prices.CPARTY :=0;
vwPrice222.Prices.NPARTY :='';
vwPrice222.Prices.SRPRICE :=0;
vwPrice222.Prices.SRVPRICE :=0;
vwPrice222.Prices.ZPRICE :=0;
vwPrice222.Prices.ZVPRICE :=0;
vwPrice222.Prices.CGRUSL :=0;
vwPrice222.Prices.ONZAVPRICE:=False;
vwPrice222.insert current Prices;
Count_Ins:=Count_Ins+1;
end;
end;

end; //конец МЦ есть или нету в Прайсе

end //конец //ищем МЦ по коду
else myWrite('Ошибка! В каталоге МЦ не найдена МЦ с кодом: '+string(mDataExcel.MCKodBS));

}while (GetNext mDataExcel = tsok);

stopvisual('',0);
end;

//──────────────────────────────────────────────────────────────────────────────
//──────────────────────────────────────────────────────────────────────────────
//──────────────────────────────────────────────────────────────────────────────
//──────────────────────────────────────────────────────────────────────────────
//──────────────────────────────────────────────────────────────────────────────
HandleEvent
cmInit: {
var m21 : array [1..2] of string;
var m22 : array [1..2] of integer;
var m2i, m2iN : integer;

set str01:='Выберите прайс-лист:';
set str02:='Укажите прайс-лист Excel для импорта данных:';
set sKlPriceNameKomm:='Информация о прайс-листе: ';

//запоняем sExcelCol_kodBS
//var m21 : array [1..2] of string;
//var m22 : array [1..2] of integer;
//var m2i, m2iN : integer;
SetLimit(m21, 0);
SetLimit(m22, 0);
SetEnumList(scr_Int_ImpPriceFromExcel, #sExcelCol_kodBS, m21, m22); // screen scr_Int_ImpPriceFromExcel
m2i:=0; m2iN:=260;
for(m2i:=1;m2i<=m2iN;m2i:=m2i+1)
begin
m21[m2i]:=' '+myGetColStrPre(m2i);
m22[m2i]:=m2i;
end;
SetEnumList(scr_Int_ImpPriceFromExcel, #sExcelCol_kodBS, m21, m22); // screen scr_Int_ImpPriceFromExcel
set iExcelListName := 1;

//запоняем sExcelCol_kodBS
//var m21 : array [1..2] of string;
//var m22 : array [1..2] of integer;
//var m2i, m2iN : integer;
SetLimit(m21, 0);
SetLimit(m22, 0);
SetEnumList(scr_Int_ImpPriceFromExcel, #sExcelCol_Price, m21, m22); // screen scr_Int_ImpPriceFromExcel
m2i:=0; m2iN:=260;
for(m2i:=1;m2i<=m2iN;m2i:=m2i+1)
begin
m21[m2i]:=' '+myGetColStrPre(m2i);
m22[m2i]:=m2i;
end;
SetEnumList(scr_Int_ImpPriceFromExcel, #sExcelCol_Price, m21, m22); // screen scr_Int_ImpPriceFromExcel
set iExcelListName := 1;

ReadDsk;
}
cmCancel1:{
if (xlIsExcelValid) then if (NOT xlKillExcel) then Message('Ошибка! xlKillExcel'); //закрываем Excel
CloseInterface(cmCancel);
Stop;
}
//──────────────────────────────────────────────────────────────────────────────
cmDone: {
if (xlIsExcelValid) then if (NOT xlKillExcel) then Message('Ошибка! xlKillExcel'); //закрываем Excel
}
//──────────────────────────────────────────────────────────────────────────────
cmQuit: {
if (xlIsExcelValid) then if (NOT xlKillExcel) then Message('Ошибка! xlKillExcel'); //закрываем Excel
}
//──────────────────────────────────────────────────────────────────────────────
cmPick: {
case CurField of
#sKlPriceName : begin

//if RunInterface('GetKlPr', cKlPriceNrec, 1, 0, 0)<>cmCancel then
if RunInterface('GetKlPr1', cKlPriceNrec, 1, 0)<>cmCancel then //только МЦ
begin
vwKlPrice999.cComp999:=cKlPriceNrec;
if vwKlPrice999.GetFirst=tsOk then set sKlPriceName:= string(vwKlPrice999.KlPrice.Name);

sKlPriceNameKomm:='Информация о прайс-листе: ';
case vwKlPrice999.KlPrice.Tip of
0 : sKlPriceNameKomm:=sKlPriceNameKomm+' прайс-лист на ТОВАРЫ, ';
1 : sKlPriceNameKomm:=sKlPriceNameKomm+' прайс-лист на УСЛУГИ, ';
end;
case vwKlPrice999.KlPrice.Vhodnal of
1 : sKlPriceNameKomm:=sKlPriceNameKomm+'налоги ВХОДЯТ в цену ';
2 : sKlPriceNameKomm:=sKlPriceNameKomm+'налоги НЕ ВХОДЯТ в цену ';
end;
set sKlPriceNameKomm:=sKlPriceNameKomm;

end;
end;
#sExcelFileName : begin
var sExcelFileNameTemp : string;
sExcelFileNameTemp:='';
sExcelFileNameTemp:=GetFileName('*.xls', 'Выберите файл для импорта данных');
if sExcelFileNameTemp<>'' then
begin
set sExcelFileName:=sExcelFileNameTemp;
//sEFN_Copy:=GetPathParameter('Files','TmpFilesDirectory',0)+'tmp'+DateToStr(Cur_Date,'YYMMDD')+TimeToStr(Cur_Time,'HHMMSS')+myGetOnlyFileName(sExcelFileName);
//if (Not CopyMoveFile(sExcelFileName,sEFN_Copy, false)) then Message('Ошибка! CopyMoveFile');
See_iExcelListName(False);
end;
end;
end;

}
//──────────────────────────────────────────────────────────────────────────────
cmPusk :
{
//ПРОВЕРКИ НА КОРРЕКТНОСТЬ ВВЕДЕННЫХ ПОЛЬЗОВАТЕЛЕМ ДАННЫХ ДАННЫХ
if sKlPriceName='' then begin Message('Укажите прайс-лист!', Warning); break; end;
if sExcelFileName='' then begin Message('Укажите прайс-лист Excel!', Warning); break; end;

SaveDsk;
Count_Ins :=0;
Count_Upd :=0;
Count_Err :=0;

PlPorList.NoDialog;
myWrite(CommonFormHeader); Count_Err:=Count_Err-1;
myWrite(''); Count_Err:=Count_Err-1;
myWrite('Прайс-лист для модификации: '+sKlPriceName); Count_Err:=Count_Err-1;
myWrite(sKlPriceNameKomm); Count_Err:=Count_Err-1;
myWrite(''); Count_Err:=Count_Err-1;
myWrite('Прайс-лист Excel: '+sExcelFileName); Count_Err:=Count_Err-1;
myWrite('---------------------------------------'); Count_Err:=Count_Err-1;

Get_Price_From_Excel; //заполняется mDataExcel - внутри визуализация

Get_MC_From_KatMC; //заполняется mDataMC - внутри визуализация

Call_ImportProcess; //импортирование прайса mDataExcel(с исп mDataMC) - в таблицу Prices - внутри визуализация

if (xlIsExcelValid) then if (NOT xlKillExcel) then Message('Ошибка! xlKillExcel'); //закрываем Excel

myWrite('---------------------------------------'); Count_Err:=Count_Err-1;
myWrite('ПРОТОКОЛ РАБОТЫ:'); Count_Err:=Count_Err-1;
myWrite('Вставлено записей: '+string(Count_Ins)); Count_Err:=Count_Err-1;
myWrite('Обновлено записей: '+string(Count_Upd)); Count_Err:=Count_Err-1;
myWrite('Ошибочных записей: '+string(Count_Err)); Count_Err:=Count_Err-1;
PlPorList.ShowFile;

CloseInterface(cmDefault);
Stop;
}
end; //HandleEvent
end.

Добавлено: 10 дек 2009, 11:53
Masygreen
код прикольный ... :) не по теме но ..

Код: Выделить всё

1. (ReadOnly) - бесполеза
2. если цыкла по выборке нет то ...
if (GetFirst FastFirstRow katos where ((BODY_KATOS_NREC==katos.nrec)) = tsOK)
3. рекомендация распологать усвловия справа and vwPrice222_c1=KlPrice.nRec
4. не пекомендуется в if использовать  break;

Добавлено: 10 дек 2009, 14:43
korvanakorvana

Код: Выделить всё

//
interface _gt_dbftogalaxy;

File Ifile;

Var wnmdir, nmdir : string;

create view 
var 
nmfile:string;
SelectBarkod:string;
PriceMin:double;
PriceMax:double;
PriceTec:double;
dateoper:date;
as
select * from 
  rzdoc
, rzspdoc
, soprhoz
, rzkutrash rzkutrash1
, rzkutprih
, katpodr
, katmol
, lastnumd
, Oborot
, RzKutRash
where
((
    2==katpodr.sklad
//and nmfile==katpodr.name
and katpodr.nrec==katmol.cskl

and 919==lastnumd.lndtype

and SelectBarkod==katmc.barkod
and katmc.nrec==rzkutprih.cmc

and PriceMin<<=rzkutprih.pprice(noindex)
and PriceMax>>=rzkutprih.pprice(noindex)
//and PriceTec==rzkutprih.pprice(noindex)

and rzkutprih.nrec==rzkutrash1.crzprih
));

handleevent

cmInit:
{
var hDBFh:longint;
var barkod,shtrihkod:string;
var price:double;
var kol:double;
var sum:double;
var section:word;
var oper:word;
var itog:double;
var tekkol:double;


If Message ( 'Загрузить продажи ?' , Confirmation+YesNo) = cmNo then 
{
closeinterface(cmCancel);
Abort;
}

else
{
Ifile.OpenFile ('c:\dbftogalaxy.txt', stCreate)
Ifile.writeln('Пользователем '+username+' в '+string(cur_time)+' '+string(cur_date)+' была произведена загрузка продаж:');
Ifile.writeln(' ');

StartNewVisual(vtRotateVisual, vfTimer+vfBreak+vfConfirm,'Подождите, идет загрузка ...',10000);

_loop katpodr
{

nmdir:='e:\ExpImp\'+trim(katpodr.name);
wnmdir:=nmdir+'\*.*' ;

if IsDirectory (nmdir) then
if findfirstfile(wnmdir,nmfile)
do 
if instr('.dbf',locase(nmfile))>0 then 
{
//	message(nmfile);
	hDBFh:=DBFOpen(nmdir+'\'+nmfile, stOpenRead);
	dateoper:=strtodate(substr(nmfile,3,6),'DDMMYY');
	if hDBFh<>0 then {
		DBFGetFirst(hDBFh);
		itog:=0;
		do {
			barkod:=substr(DBFGetFieldValue (hDBFh,'CODE'),1,6);
			price:=double(DBFGetFieldValue (hDBFh,'PRICE'));
			kol:=double(DBFGetFieldValue (hDBFh,'KOL'));
			sum:=double(DBFGetFieldValue (hDBFh,'SUM'));
			section:=word(DBFGetFieldValue (hDBFh,'SECTION'));
			oper:=word(DBFGetFieldValue (hDBFh,'OPER'));
			itog:=itog+sum;
		}
		while DBFGetNext(hDBFh)=0;

		Ifile.writeln('Наименование розничной точки - '+nmfile);
		var i:longint;

		i:=0;
		_loop katmol i:=i+1;

		if i>1 message('Для данной аптеки МОЛ больше одного');

		_loop soprhoz where ((dateoper==soprhoz.datob and 919==soprhoz.tipdoc)) {
		
			if getfirst rzdoc where ((soprhoz.csoprdoc==rzdoc.nrec))=tsOk {

				Ifile.writeln('select * from rzspdoc where ((' + string(rzdoc.nrec) +'==rzspdoc.csopr));');
				delete from rzspdoc where ((rzdoc.nrec==rzspdoc.csopr));

				Ifile.writeln('select * from rzkutrash where ((' + string(rzdoc.nrec) +'==rzkutrash.csopr));');
				delete from rzkutrash where ((rzdoc.nrec==rzkutrash.csopr));

				Ifile.writeln('Удалена запись в таблице rzdoc на сумму '+ string(rzdoc.price)+ ' N ' + string(rzdoc.ndoc) + ' от ' +  string(rzdoc.ddoc));
				delete current rzdoc;
			}

			Ifile.writeln('delete from oborot where ((' + string(soprhoz.nrec) + '==oborot.csoprhoz))');
			delete from oborot where ((soprhoz.nrec==oborot.csoprhoz));
			
			delete current soprhoz;

			Ifile.writeln('Удалена запись в таблице soprhoz на сумму '+string(soprhoz.summa) + ' N ' + string(soprhoz.nodoc) + ' от ' +  string(soprhoz.datob));
		}

		insert into rzdoc set 
		rzdoc.ndoc:=lastnumd.lndnum,
		rzdoc.ddoc:=dateoper,
		rzdoc.cpodrfrom:=katpodr.nrec,
		rzdoc.cmolfrom:=katmol.nrec,
		rzdoc.typemove:=919,
		rzdoc.typePLAT:=1,
		rzdoc.price:=itog,
		rzdoc.vprice:=itog,
		rzdoc.dopr:=dateoper;
                
		insert into soprhoz set
		soprhoz.datob:=dateoper,
		soprhoz.csoprdoc:=rzdoc.nrec,
		soprhoz.tipdoc:=919,
		soprhoz.tidkgal:=919,
		soprhoz.nodoc:=lastnumd.lndnum,
		soprhoz.descr:='+++',
		soprhoz.summa:=itog,
		soprhoz.sumvalut:=itog,
		soprhoz.direct:=2;
                
		update current lastnumd set lastnumd.lndnum:=replace(lpad(string(word(lastnumd.lndnum)+1),length(lastnumd.lndnum)),' ','0');
                DBFGetFirst(hDBFh);

		do {
			if (not nextvisual)  break;

			shtrihkod:=trim(DBFGetFieldValue (hDBFh,'CODE'));
			price:=double(DBFGetFieldValue (hDBFh,'PRICE'));
			kol:=double(DBFGetFieldValue (hDBFh,'KOL'));
			sum:=double(DBFGetFieldValue (hDBFh,'SUM'));
			section:=word(DBFGetFieldValue (hDBFh,'SECTION'));
			oper:=word(DBFGetFieldValue (hDBFh,'OPER'));

			// позиционируемя на приход с данной мц (по баркоду) и розницной ценой
			PriceMin:=double(substr(shtrihkod,length(shtrihkod)-6,4)+'.'+substr(shtrihkod,length(shtrihkod)-2,2))-0.02;
			PriceMax:=double(substr(shtrihkod,length(shtrihkod)-6,4)+'.'+substr(shtrihkod,length(shtrihkod)-2,2))+0.02;
			//PriceTec:=double(substr(shtrihkod,length(shtrihkod)-6,4)+'.'+substr(shtrihkod,length(shtrihkod)-2,2));
			//message(string(price)+' '+string(PriceMin));
			barkod:= substr(shtrihkod,1,length(shtrihkod)-7);
			SelectBarkod:=barkod;

			// Если их несколько - нужно распределить расход по приходам - 
			// т.е. из какого прихода скоко ушло в расход
			// если сумма расхода> сумма прихода - в спецификацию розницы 
			// создается несколько записей с различными ссылками на приход

			getfirst katmc;

			Ifile.writeln(shtrihkod+'  '+ string(kol) + ' ' + string(price)+'  '+katmc.name);


			if getfirst rzkutprih<>tsOk 
				then message('Приходов '+katmc.name+' с ценой '+string(price)+' не было');

			// пересчитываем (на всякий случай) отстаток rzkutprih.ostatok по данному приходу

			tekkol:=kol;

				do {
					var rost:double;

					rost := rzkutprih.kol; //рассчитаннный остаток по приходу

//					if (katmc.barkod='605364') message('605364 ' + RecordsInTable(tnrzkutprih));

					_loop rzkutrash1 {
						rost:= rost - rzkutrash1.kol;
					}
	
					if (abs(rzkutprih.ostatok-rost) > 0.01) then {			
						Ifile.writeln('! Пересчёт остатка '+katmc.barkod + ' ' + katmc.name + ' Рассчитанный остаток ' + string(rost) + ' остаток в базе ' + string(rzkutprih.ostatok));
						update current rzkutprih set rzkutprih.ostatok:=rost;
					}

				//message('распределяем '+string(tekkol)+' остаток '+string(rzkutprih.ostatok));

					if tekkol<0  then { // возвратный чек

						Ifile.writeln('!!! Возврат '+ katmc.barkod + ' ' + katmc.name+' '+string(tekkol)+' упаковок по цене '+ string(price));
						message('ВНИМАНИЕ !!! ВОЗВРАТ ТОВАРА !!! ');
						message(katmc.barkod + ' ' + katmc.name+' '+string(tekkol)+' упаковок по цене '+ string(price));

						insert into rzspdoc set
						rzspdoc.ckutprih:=rzkutprih.nrec,
						rzspdoc.cmc:=katmc.nrec,
						rzspdoc.ddoc:=dateoper,
						rzspdoc.typeprih:=919,
						rzspdoc.csopr:=rzdoc.nrec,
						rzspdoc.cpartyfrom:=rzkutprih.cpartyfrom,
						rzspdoc.cparty:=rzkutprih.cparty,
						rzspdoc.cgroupmc:=rzkutprih.cgroupmc,
						rzspdoc.zkprice:=1,
						rzspdoc.fprice:=rzkutprih.fprice,
						rzspdoc.vcurse:=1,
						rzspdoc.price:=price,
						rzspdoc.rprice:=price,
						rzspdoc.pprice:=price,
						rzspdoc.kol:=tekkol,
						rzspdoc.ostatok:=rzkutprih.ostatok;
	
						insert into rzkutrash set
						rzkutrash.ddoc:=dateoper,
						rzkutrash.typerash:=919,
						rzkutrash.typeplat:=1,
						rzkutrash.kol:=tekkol,
						rzkutrash.price:=price,
						rzkutrash.vprice:=price,
						rzkutrash.csopr:=rzdoc.nrec,
						rzkutrash.crzprih:=rzkutprih.nrec,
						rzkutrash.cspdoc:=rzspdoc.nrec,
						rzkutrash.cmc:=katmc.nrec,
						rzkutrash.cpodr:=katpodr.nrec,
						rzkutrash.cmol:=katmol.nrec;

						update current rzkutprih set rzkutprih.ostatok:=rzkutprih.ostatok - tekkol;

						tekkol:=0;

					} else if tekkol>=rzkutprih.ostatok then  {
						if rzkutprih.ostatok>0 then insert into rzspdoc set
						rzspdoc.ckutprih:=rzkutprih.nrec,
						rzspdoc.cmc:=katmc.nrec,
						rzspdoc.ddoc:=dateoper,
						rzspdoc.typeprih:=919,
						rzspdoc.csopr:=rzdoc.nrec,
						rzspdoc.cpartyfrom:=rzkutprih.cpartyfrom,
						rzspdoc.cparty:=rzkutprih.cparty,
						rzspdoc.cgroupmc:=rzkutprih.cgroupmc,
						rzspdoc.zkprice:=1,
						rzspdoc.fprice:=rzkutprih.fprice,
						rzspdoc.vcurse:=1,
						rzspdoc.price:=price,
						rzspdoc.rprice:=price,
						rzspdoc.pprice:=price,
						rzspdoc.kol:=rzkutprih.ostatok,
						rzspdoc.ostatok:=rzkutprih.ostatok;
	
						if rzkutprih.ostatok>0 then insert into rzkutrash set
						rzkutrash.ddoc:=dateoper,
						rzkutrash.typerash:=919,
						rzkutrash.typeplat:=1,
						rzkutrash.kol:=rzkutprih.ostatok,
						rzkutrash.price:=price,
						rzkutrash.vprice:=price,
						rzkutrash.csopr:=rzdoc.nrec,
						rzkutrash.crzprih:=rzkutprih.nrec,
						rzkutrash.cspdoc:=rzspdoc.nrec,
						rzkutrash.cmc:=katmc.nrec,
						rzkutrash.cpodr:=katpodr.nrec,
						rzkutrash.cmol:=katmol.nrec;

						tekkol:=tekkol-rzkutprih.ostatok;
						update current rzkutprih set rzkutprih.ostatok:=0;
					} else	{
						if tekkol>0 then insert into rzspdoc set
						rzspdoc.ckutprih:=rzkutprih.nrec,
						rzspdoc.cmc:=katmc.nrec,
						rzspdoc.ddoc:=dateoper,
						rzspdoc.typeprih:=919,
						rzspdoc.csopr:=rzdoc.nrec,
						rzspdoc.cpartyfrom:=rzkutprih.cpartyfrom,
						rzspdoc.cparty:=rzkutprih.cparty,
						rzspdoc.cgroupmc:=rzkutprih.cgroupmc,
						rzspdoc.zkprice:=1,
						rzspdoc.fprice:=rzkutprih.fprice,
						rzspdoc.vcurse:=1,
						rzspdoc.price:=price,
						rzspdoc.rprice:=price,
						rzspdoc.pprice:=price,
						rzspdoc.kol:=tekkol,
						rzspdoc.ostatok:=rzkutprih.ostatok;
	
						if tekkol>0 then insert into rzkutrash set
						rzkutrash.ddoc:=dateoper,
						rzkutrash.typerash:=919,
						rzkutrash.typeplat:=1,
						rzkutrash.kol:=tekkol,
						rzkutrash.price:=price,
						rzkutrash.vprice:=price,
						rzkutrash.csopr:=rzdoc.nrec,
						rzkutrash.crzprih:=rzkutprih.nrec,
						rzkutrash.cspdoc:=rzspdoc.nrec,
						rzkutrash.cmc:=katmc.nrec,
						rzkutrash.cpodr:=katpodr.nrec,
						rzkutrash.cmol:=katmol.nrec;
		
					        update current rzkutprih set rzkutprih.ostatok:=rzkutprih.ostatok-tekkol;
						tekkol:=0;
					}
					if tekkol>0 then if getnext rzkutprih<>tsOk then {
						Ifile.writeln('!!! Нераспределено '+ katmc.barkod + ' ' + katmc.name+' '+string(tekkol)+' упаковок');
//						message('Нераспределено '+ katmc.barkod + ' ' + katmc.name+' '+string(tekkol)+' упаковок');
						tekkol:=0;
					}
				}
				while tekkol>0
			}
			while DBFGetNext(hDBFh)=0; 
		
                        }
			update current rzdoc;
			update current soprhoz;
			DBFClose (hDBFh);

	//deletefile(nmdir+'\'+nmfile);
	if CopyMoveFile (nmdir+'\'+nmfile, nmdir+'\SellArhiv\'+nmfile, True) {
		Ifile.writeln('Файл '+nmdir+'\'+nmfile+' обработан и перемещён в архив '+nmdir+'\SellArhiv\'+nmfile);
	} else message('Ошибка перемещения файла '+nmdir+'\'+nmfile+' в '+nmdir+'\SellArhiv\'+nmfile);



}
while findnextfile(nmfile)
}

Ifile.Close();

var expfile:string;

expfile:= 'e:\SellProcess\export-'+DateToStr(Cur_Date, 'YYYYMMDD') +'-'+TimeToStr(Cur_Time,'HHMMSS') +'-'+sGetTune('USER.DESCR');

//message(expfile);

CopyMoveFile ('c:\dbftogalaxy.txt', expfile, False);

StopVisual('Загрузка произведена',0);

ProcessText('c:\dbftogalaxy.txt',vfDefault Or vfEscable Or vfNewTitle Or vfToErase,'Отчет о проданных в розницу товарах');
Abort;
}
}

cmCancel:
{
}

end;
end.
ЗАГРУЗКА ИЗ DBF в Галку. Конкретно из Штрих-м .

Добавлено: 15 дек 2009, 16:59
savov
Можно из екселя, причем у нас бухсправку по энергетике сначала из дбф экспортировали, потом из экселя. Код экспорта из экселя (часть кода удалена, т.к. не имеет отношения к делу):

FileName:=GetFileName('*.xls','Выбор xls-файла');
datobi:=TParam.tDate;

if ((not xlOpenExcel(false)) or (not xlOpenWorkBook(FileName)))
{Message('Ошибка! Не могу открыть файл!',0)}
else
{
........

Descri:=UseriD;
r:=tTune.GetFirst;
descrip:=tTune.Strval;

.......

result:=xlSetActiveSheetByName('Буфер');
i:=2;
Strperem:='';
result:=xlGetCellValue(i,1,Strperem);
While(Strperem<>'')
{
result:=xlGetCellValue(i,1, Strperem);
i:=i+1;
};
kolrow:=i-2;
result:=xlGetCellValue(2,10, Strperem);

.........

DNoDoc:=String(Strperem);
INSERT plpor SET DATOB=datobi, DATOTS=DATOBI, DATVIP=DATOBI, MODEDOC=4098, YEARDOC=YEAR(datobi),
NODOK=DNoDOc, TIDK=10, TIDKGAL=10, VIDDK=0, Descr=Descrip;
resbuh:=BuchSpr.getfirst;
NrecBuch:=BuchSpr.Plpor.Nrec;
SummaPlat:=0;
INSERT soprhoz SET DATOB=datobi, MODEDOC=4098,
NODOC=DNoDOc, TIDKBASE=0, TIDKGAL=10, Descr=Descrip, VHSUMHOZ='+', DIRECT=0, CSOPRDOC=NrecBuch;



StartNewVisual(vtRotateVisual, vfTimer,' Импорт проводок. Бухсправка N '+String(DNoDoc),1);

for(i:=2;i<=kolrow;i:=i+1)
{
result:=xlGetCellValue(i,1,Strperem);
NPodrD:=String(Strperem);
result:=xlGetCellValue(i,5,Strperem);
Npodrk:=String(Strperem);
IF (Substr(NpodrD,4,1)='k' OR Substr(NPodrD,4,1)='к') then NPodrD:=Substr(NPodrD,1,3)+'_к';

result:=xlGetCellValue(i,2,Strperem);
Nscheto:='1'+String(Strperem);
result:=xlGetCellValue(i,6,Strperem);
Nschetk:='1'+String(Strperem);
result:=xlGetCellValue(i,3,Strperem);
Nsubossch:=String(Strperem);
result:=xlGetCellValue(i,7,Strperem);
Nsubschk:=String(Strperem);


IF ((kauos1<>'00000') and (ckauos1=0))
{
FileLog.Writeln('Для документа '+DNoDOc+'(проводка Д'+Substr(Nscheto,2,2)+' '+Nsubossch+' - К'+Substr(Nschetk,2,2)+' '+Nsubschk+') не найден КАУ деб. 1 ур: КАУ: '+kauos1);
}
if ((kauks1<>'00000') and (ckauks1=0))
{
FileLog.Writeln('Для документа '+DNoDOc+'(проводка Д'+Substr(Nscheto,2,2)+' '+Nsubossch+' - К'+Substr(Nschetk,2,2)+' '+Nsubschk+') не найден КАУ кред. 1 ур: КАУ: '+kauks1);
}
result:=xlGetCellValue(i,9,Strperem);
StrPerem:=Replace(Strperem,',','.');
ISUMOB:=Double(Strperem);
result:=xlGetCellValue(i,9,Strperem);
IKOL:=String(Strperem);



TIDK:=10;
TIDKGAL:=10;
CVHPROp:='+';
NSCHETOU:=Substr(Nscheto,2,2);
NSCHETKU:=Substr(Nschetk,2,2);
SummaPlat:=SummaPlat+Isumob;
if (Isumob>0) {
INSERT oborot SET DATOB=datobi,
NODOK=dNODOc, SCHETO=NScheto, Schetk=NSchetk,
Subossch:=NSubossch, Subschk=NSubschk, KAUOS[1]=Ckauos1,
KAUKS[1]=Ckauks1,
DBSCHETO=NSCHETOU, KRSCHETK=NSCHETKU,
TBLOS[1]=Ktableos1, TBLKS[1]=ktableks1,
KODSPO=CPODRD, KODSPK=CPODRK, SUMOB=ISumob, KOL=0, CPlanssch=Cplan, CSoprdoc=NrecBuch, Csoprhoz=NrecCSopr,
Tidk=10, TidkGal=10, Descr=descrip, VHprop=Cvhprop;}
Ckauos1:=0;
Ckauks1:=0;
CpodrD:=0;
CPodrK:=0;
}

Update PLPOR WHERE (Plpor.Nrec=NrecBuch) SET SumPlat=SummaPlat;
Update SOPRHOZ WHERE(SOPRHOZ.nrec=NrecCSopr) set summa=SummaPlat;
FileLog.Writeln('Бухсправка '+DNoDoc+' сформирована с суммой '+String(SummaPlat));
StopVisual('',0);
Message ('Справка создана!',0);
FileLog.close;
FileName:=substr(filename,1,instr('.xls',FileName)-1)+'1'+'.xls';
Message(FileName,0);
result:=DeleteFile(FileName);
result:=xlKillExcel;
ProcessText('%startpath%\impenergrez.txt',vfDefault,'Результаты импорта:');
CloseInterface(CmOK);

}
}
cmgEsc:
{ CloseInterface(CmOK);
}
end; // HandleEvent


end;// panel

end. // interface
Часовой пояс: UTC+05:00
Страница 2 из 2

Создано на основе phpBB® Forum Software © phpBB Limited

Русская поддержка phpBB