Можно ли загрузить данные из файла .xls в Галактику?
Модераторы: m0p3e, edward_K, Модераторы
Если таблица одна, то зачем такие сложности?:Можно ли загрузить данные из файла .xls в Галактику?
Еслив можно то как енто делается?
в модуле SQL есть великолептая комманда import
import oborot from dbf D:\oborot.dbf fsnr; параметры найдёте
А Если таблиц несколько и она связаны и "загрузить данные" это интерфейс для частого использование и/или для пользователя, то: открываем, читаем, ковыряем, закрываем. И в сравнении с ковыряем выбор между DBFGetFieldValue и xlGetCellValue просто несущественен. Любая вам поможет.
про работе с 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);
}
Код: Выделить всё
FUNCTION dBF_DATE(DD:LongInt;D:STRING):DATE;
StrToDate(dbfD,'YYYYMMDD')
-
- Посетитель
- Сообщения: 39
- Зарегистрирован: 29 мар 2005, 17:49
- Откуда: Стерлитамак
- Контактная информация:
Пример работы с 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.
Самописный фейс "Импорт цен МЦ в прайс-лист из 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.
-
- Местный житель
- Сообщения: 1089
- Зарегистрирован: 04 сен 2008, 11:27
- Откуда: Москва
- Контактная информация:
код прикольный ... не по теме но ..
Код: Выделить всё
1. (ReadOnly) - бесполеза
2. если цыкла по выборке нет то ...
if (GetFirst FastFirstRow katos where ((BODY_KATOS_NREC==katos.nrec)) = tsOK)
3. рекомендация распологать усвловия справа and vwPrice222_c1=KlPrice.nRec
4. не пекомендуется в if использовать break;
Время ведет!
-
- Местный житель
- Сообщения: 429
- Зарегистрирован: 24 сен 2008, 11:53
Код: Выделить всё
//
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.
-
- Местный житель
- Сообщения: 589
- Зарегистрирован: 29 мар 2005, 17:49
- Откуда: Воронеж ОАО Верофарм. Воронеж
Можно из екселя, причем у нас бухсправку по энергетике сначала из дбф экспортировали, потом из экселя. Код экспорта из экселя (часть кода удалена, т.к. не имеет отношения к делу):
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
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