Творец
Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант
Репутация: 36
Всего: 329
|
Я когда-то для DRKB давал исходники по импорту из Excel (прошу обратить внимание, что тогда я был под ником dsergey) Прошу заменить импорт из Excel на эту процедуру, т.к. она работает на много быстрее. (Тогда она называлась ImportFromExcel, помоему) Экспорт в Excel не менял  даю полностью рабочий код | Код |
uses ...
ExcelXP, OleServer, ComObj, ...
{
Ex1 - TExcelApplication со страницы Servers
dm - TDataModule
tArrivalDet, tPreparats, tArrival - TpFibDataBase
считаю, что такие функции, как DelProb или FindPreparat не требуется сюда выкладывать, т.к. у всех своя специфика, тем
более, что они никакого отношения не имеют к импорт из Excel
}
procedure TfmImpFromExcel.ImportArrivalFromExcel(FileName: String);
Var
WorkBk : _WorkBook; // определяем WorkBook
WorkSheet : _WorkSheet; // определяем WorkSheet
Range:OleVariant;
iUnitID,iUnit, iAmount, iTerm,iPrepID, iSeries, iStop, iProd, iPrice, RowsToCopy, iLastRow, iWBIndex, x, iBook, iNameRow : integer;
sInvoiceNum, sUnitCol, sAmountCol, sTermCol, sProdCol, sPriceCol, sNameCol, sSeriesCol, sFileName : String;
bNaydeno7, bNaydeno6, bNaydeno5, bNaydeno4, bNaydeno2, bNaydeno1, bNaydeno, bNaydeno3 : boolean;
vPrep:variant;
НайденоВБазе, НеНайденоВБазе:integer;
Препарат, Производитель, Серия, Единица: String;
ЦенабНДС,НДС, ЦенаСНДС : real;
ArrivalID : integer;
begin
sFileName := '';
screen.Cursor := crHourGlass;
try
sInvoiceNum := AnsiUpperCase(ExtractFileName(FileName));
sInvoiceNum := Copy(sInvoiceNum, 1, pos('.XLS',sInvoiceNum)-1);
fmNewArrival.edInvoice_num.Text := sInvoiceNum;
dm.tPreparats.DisableControls;
dm.tPreparats.AutoCommit := false;
if not dm.tArrivalDet.active then
dm.tArrivalDet.Open;
dm.tArrivalDet.DisableControls;
dm.tArrivalDet.AutoCommit := False;
dm.tArrivalDet.BeforeInsert := nil;
dm.tArrivalDet.AfterPost := nil;
НеНайденоВБазе := 0;
НайденоВБазе := 0;
try//попытка открытия файла
Ex1.Connect;
Ex1.Workbooks.Open(FileName,EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam, EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam, LOCALE_USER_DEFAULT);
Ex1.Application.EnableEvents := false;
except;//в случае ошибки все отменяем и обнуляем
screen.Cursor:=crDefault;
RowsToCopy := 0;
exit;
end;//try-except Ex1.Connect
sFileName := ExtractFileName(FileName);
For iWBIndex := 1 to ex1.Workbooks.Count do
if ex1.Workbooks.Item[iWBIndex].Name = sFileName then break;
WorkBk := ex1.WorkBooks.Item[iWBIndex]; // Выбираем WorkBook
// Определяем WorkSheet
if WorkBk.Worksheets.Count>1 then
begin//если кол-во листов больше 1
For x:=0 to memoSheets.Lines.Count-1 do
begin
For iBook:=1 to WorkBk.Worksheets.Count do
begin
WorkSheet:=WorkBk.WorkSheets.Get_Item(iBook) as _WorkSheet;
if WorkSheet.Name = memoSheets.Lines[x] then
begin
bNaydeno3:=True;//нашли лист
WorkSheet.Activate(LOCALE_USER_DEFAULT);//активираем лист
end;//if WorkSheet.Name = memoSheets.Lines[x] then begin
if bNaydeno3 then break;
end;//For iBook:=1 to WorkBk.Worksheets.Count do begin
if bNaydeno3 then break;
end;//For x:=0 to memoSheets.Lines.Count-1 do begin
//если не находим лист из списка ключевых слов, выдаем сообщение
if not bNaydeno3 then
begin
beep;
ShowMessage('<Не найден лист с данными>'+#13+#13+
'1.Откройте прайс, посмотрите название листа с препаратами, добавьте в'+#13+
'ключевые слова название листа с препаратами и повторите импорт'+#13+
'___________________________________________________________________________________'+#13+
'2.Откройте прайс, выберите лист с препаратами, затем выберите меню "Файл->Сохранить и закройте Excel"');
exit;
end;//if bNaydeno3=false then begin
end else//if
WorkSheet:=WorkBk.WorkSheets.Get_Item(1) as _WorkSheet;;
StatusBar1.Panels[0].Text:='Поиск последней строки...';
application.ProcessMessages;
if Find('99999',iNameRow, sNameCol, WorkSheet) then
begin
iLastRow:=iNameRow-1;//в столбце с наименованием ищем "99999"-конец импорта
end
else
begin //и запоминаем в iRows
try//если не находим 99999 то ищем последнюю заполненную ячейку
WorkSheet.Cells.SpecialCells(xlCellTypeLastCell,EmptyParam).Activate;
// Получаем значение последней строки
iLastRow:=(ex1.ActiveCell.Row)-1;
except
try
WorkSheet.Cells.SpecialCells(xlCellTypeLastCell,EmptyParam).Select;
// Получаем значение последней строки
iLastRow:=(ex1.ActiveCell.Row);
except
iLastRow:=0;
end;//try-except
end;//try-except
end;//else
if iLastRow=0 then
begin
memoErrors.Lines.Add(TimeToStr(Time)+' Не найден признак окончания данных, импортируем 6000 строк');
iLastRow:=6000;
end;//if iRows=0 then begin
//показываем кол-во строк для копирования
memoErrors.Lines.Add(TimeToStr(Time)+' Записей для импорта '+IntToStr(RowsToCopy));
//ищем наименование препаратов
For x:=0 to memoName.Lines.Count-1 do
begin
bNaydeno:=False;
if Find(memoName.Lines[x],iNameRow,sNameCol,WorkSheet) then begin
bNaydeno:=True;
//количество строк для копирования
RowsToCopy := iLastRow - iNameRow;
break;
end;//if Find(memoNames.Lines[r],iNameRow,sNameCol) then begin
end;//For r:=0 to memoNames.Lines.Count-1 do begin
if not bNaydeno then
begin
beep;
ShowMessage('<Не найден столбец с наименованиями>'+#13+#13+
'1.Откройте прайс, посмотрите название столбца с наименованиями,'+#13+
'добавьте в ключевые слова название этого столбца и повторите импорт'+#13+
'-----------------------------------------------------------------------------'+#13+
'2.Откройте прайс, выберите лист с препаратами, затем выберите меню "Файл->Сохранить"');
memoErrors.Lines.Add(TimeToStr(Time)+' Не найден столбец с производителем препаратов.');
memoErrors.Lines.Add(TimeToStr(Time)+' Импорт завершен неудачно');
memoErrors.Lines.Add('___________________________________________');
exit;
end;//if bNaydeno2=False then begin
//ищем серию препаратов
For x:=0 to memoSeries.Lines.Count-1 do
begin
bNaydeno4:=False;
if Find(memoSeries.Lines[x],iSeries,sSeriesCol,WorkSheet) then
begin
bNaydeno4:=True;
break;
end;
end;
if not bNaydeno4 then
begin
beep;
ShowMessage('<Не найден столбец с сериями препаратов>'+#13+#13+
'1.Откройте прайс, посмотрите название столбца с сериями препаратов, добавьте в'+#13+
'ключевые слова название этого столбца и повторите импорт.'+#13+
'___________________________________________________________________________________'+#13+
'2.Откройте прайс, выберите лист с препаратами, затем выберите меню "Файл->Сохранить"');
memoErrors.Lines.Add(TimeToStr(Time)+' Не найден столбец с сериями препаратов.');
memoErrors.Lines.Add(TimeToStr(Time)+' Импорт завершен неудачно');
memoErrors.Lines.Add('___________________________________________');
exit;
end;
//ищем Ед. изм препаратов
For x:=0 to memoUnits.Lines.Count-1 do
begin
bNaydeno7:=False;
if Find(memoUnits.Lines[x],iUnit,sUnitCol,WorkSheet) then
begin
bNaydeno7:=True;
break;
end;
end;
if not bNaydeno7 then
begin
beep;
ShowMessage('<Не найден столбец с единицами измерений>'+#13+#13+
'1.Откройте прайс, посмотрите название столбца с ед.изм., добавьте в'+#13+
'ключевые слова название этого столбца и повторите импорт.'+#13+
'___________________________________________________________________________________'+#13+
'2.Откройте прайс, выберите лист с препаратами, затем выберите меню "Файл->Сохранить"');
memoErrors.Lines.Add(TimeToStr(Time)+' Не найден столбец с сериями препаратов.');
memoErrors.Lines.Add(TimeToStr(Time)+' Импорт завершен неудачно');
memoErrors.Lines.Add('___________________________________________');
exit;
end;
//ищем цену препаратов
For x:=0 to memoPrice.lines.Count-1 do
begin
bNaydeno1:=False;
if Find(memoPrice.lines[x],iPrice,sPriceCol,WorkSheet) then begin
bNaydeno1:=True;
break;
end;//if Find(memoPrices.lines[r],iPriceRow,sPriceCol) then begin
end;//For r:=0 to memoPrices.lines.Count-1 do begin
if not bNaydeno1 then
begin
beep;
ShowMessage('<Не найден столбец с ценами препаратов>'+#13+#13+
'1.Откройте прайс, посмотрите название столбца с ценами препаратов, добавьте в'+#13+
'ключевые слова название этого столбца и повторите импорт.'+#13+
'___________________________________________________________________________________'+#13+
'2.Откройте прайс, выберите лист с препаратами, затем выберите меню "Файл->Сохранить"');
memoErrors.Lines.Add(TimeToStr(Time)+' Не найден столбец с ценами препаратов.');
memoErrors.Lines.Add(TimeToStr(Time)+' Импорт завершен неудачно');
memoErrors.Lines.Add('___________________________________________');
exit;
end;//if bNaydeno1=false then begin
//ищем количество
For x:=0 to memoAmount.lines.Count-1 do
begin
bNaydeno6:=False;
if Find(memoAmount.lines[x],iAmount,sAmountCol,WorkSheet) then begin
bNaydeno6:=True;
break;
end;//if Find(memoPrices.lines[r],iPriceRow,sPriceCol) then begin
end;//For r:=0 to memoPrices.lines.Count-1 do begin
if not bNaydeno6 then
begin
beep;
ShowMessage('<Не найден столбец "количество">'+#13+#13+
'1.Откройте прайс, посмотрите название столбца с количеством, добавьте в'+#13+
'ключевые слова название этого столбца и повторите импорт.'+#13+
'___________________________________________________________________________________'+#13+
'2.Откройте прайс, выберите лист с препаратами, затем выберите меню "Файл->Сохранить"');
memoErrors.Lines.Add(TimeToStr(Time)+' Не найден столбец "количество".');
memoErrors.Lines.Add(TimeToStr(Time)+' Импорт завершен неудачно');
memoErrors.Lines.Add('___________________________________________');
exit;
end;//if bNaydeno1=false then begin
//ищем производителя препаратов
For x:=0 to memoProducer.Lines.Count-1 do
begin
bNaydeno2:=False;
if Find(memoProducer.Lines[x],iProd,sProdCol,WorkSheet) then begin
bNaydeno2:=True;
break;
end;//if Find(memoProd.Lines[r],iProdRow,sProdCol) then begin
end;//For r:=0 to memoProd.Lines.Count-1 do begin
if not bNaydeno2 then
begin
beep;
ShowMessage('<Не найден столбец с наименованиями производителей>'+#13+#13+
'1.Откройте прайс, посмотрите название столбца с наименованиями производителей,'+#13+
'добавьте в ключевые слова название этого столбца и повторите импорт'+#13+
'-----------------------------------------------------------------------------'+#13+
'2.Откройте прайс, выберите лист с препаратами, затем выберите меню "Файл->Сохранить"');
memoErrors.Lines.Add(TimeToStr(Time)+' Не найден столбец с производителем препаратов.');
memoErrors.Lines.Add(TimeToStr(Time)+' Импорт завершен неудачно');
memoErrors.Lines.Add('___________________________________________');
exit;
end;//if bNaydeno2=False then begin
//ищем срок годности препаратов
For x:=0 to memoTerm.Lines.Count-1 do
begin
bNaydeno5:=False;
if Find(memoTerm.Lines[x],iTerm,sTermCol,WorkSheet) then begin
bNaydeno5:=True;
break;
end;//if Find(memoProd.Lines[r],iProdRow,sProdCol) then begin
end;//For r:=0 to memoProd.Lines.Count-1 do begin
if not bNaydeno5 then
begin
beep;
ShowMessage('<Не найден столбец со сроком годности препаратов>'+#13+#13+
'1.Откройте прайс, посмотрите название столбца со сроком годности,'+#13+
'добавьте в ключевые слова название этого столбца и повторите импорт'+#13+
'-----------------------------------------------------------------------------'+#13+
'2.Откройте прайс, выберите лист с препаратами, затем выберите меню "Файл->Сохранить"');
memoErrors.Lines.Add(TimeToStr(Time)+' Не найден столбец со сроком годности препаратов.');
memoErrors.Lines.Add(TimeToStr(Time)+' Импорт завершен неудачно');
memoErrors.Lines.Add('___________________________________________');
exit;
end;//if bNaydeno2=False then begin
pb1.Max:=RowsToCopy;
StatusBar1.Panels[0].Text:='Импорт начат...';
application.ProcessMessages;
iStop := 0;
//начинаем импорт со строки iNameRow
//начинаем импорт со строки iNameRow
Inc(iNameRow);
For x:=0 to RowsToCopy do
with dm do
begin
Препарат := Trim(VarToStr(WorkSheet.Cells.Item[iNameRow,sNameCol].Value));
if (POS('ОТПУЩЕНО',AnsiUpperCase(Препарат)) <> 0) or
(POS('ВСЕГО',AnsiUpperCase(Препарат)) <> 0) or
(POS('ОПЛАТА',AnsiUpperCase(Препарат)) <> 0) or
(Препарат = '')
then continue;
Серия := Trim(VarToStr(WorkSheet.Cells.Item[iNameRow,sSeriesCol].Value));
Производитель := Trim(VarToStr(WorkSheet.Cells.Item[iNameRow,sProdCol].Value));
Единица := Trim(VarToStr(WorkSheet.Cells.Item[iNameRow,sUnitCol].Value));
if Единица = '' then Единица := 'шт';
if cbWithVAT.Checked then begin
ЦенабНДС := StrToFloatDef(DelProb(VarToStr(WorkSheet.Cells.Item[iNameRow,sPriceCol].Value)),0);
НДС := (ЦенабНДС * 1.2)-ЦенабНДС;
ЦенаСНДС := ЦенабНДС + НДС;
end else begin//без НДС
ЦенабНДС := StrToFloatDef(DelProb(VarToStr(WorkSheet.Cells.Item[iNameRow,sPriceCol].Value)),0);
НДС := 0.00;
ЦенаСНДС := ЦенабНДС;
end;
if (Препарат = '') or (Препарат = ' ')
then
Inc(iStop)//если пустая строка, то увеличиваем на 1
else
iStop := 0;//если следующая не пустая то обнуляем и продолжаем импорт
//если начались пустые строки то прекращаем импорт
if iStop > 4 then break;
//наименование препарата сначала нужно найти в справочнике препаратов
iPrepID := -1;
ArrivalID := tArrivalID.Value;
if (tArrival.state = dsEdit) or (tArrival.state = dsInsert) then begin
tArrival.post;
tArrival.locate('ID', ArrivalID, []);
tArrival.edit;
end;
if FindPreparat(Препарат, Производитель, iPrepID)
then
begin//если нашли, то у нас есть его ID, т.е. iPrepID
//добавляем в приход
Inc(НайденоВБазе);
tArrivalDet.Append;
tArrivalDetARRIVAL_ID.Value := ArrivalID;
tArrivalDetPREPARAT_ID.Value := iPrepID;
tArrivalDetPRICE_WO_NDS.AsFloat := ЦенаБНДС;
tArrivalDetPRICE_W_VAT.AsFloat := ЦенаСНДС;
tArrivalDetVAT.AsFloat := НДС;
tArrivalDetPRICE_RETAIL.AsFloat := RoundPrice(RoundTo(ЦенаСНДС * fmNewArrival.ceCoeff.Value,-2));
tArrivalDetAMOUNT.Value := StrToFloatDef(DelProb(VarToStr(WorkSheet.Cells.Item[iNameRow,sAmountCol].Value)),0);
tArrivalDetSERIES.AsString := Серия;
tArrivalDetUNIT_ID.Value := FindUnit(Единица);
tArrivalDet.Post;
end
else
begin//добавляем в справочник препаратов новый препарат
Inc(НеНайденоВБазе);
tPreparats.Append;
iPrepID := tPreparatsID.Value;
tPreparatsNAME.Value := Препарат;
tPreparatsPRODUCER.Value := Производитель;
tPreparatsSERIES.Value := Серия;
tPreparatsPRICE_RETAIL.AsFloat := RoundPrice(RoundTo(ЦенаСНДС * fmNewArrival.ceCoeff.Value,-2));
tPreparatsPRICE_WO_VAT.AsFloat := ЦенаСНДС;
tPreparatsTERM.Value := Trim(VarToStr(WorkSheet.Cells.Item[iNameRow,sTermCol].Value));
tPreparatsUNIT_ID.Value := FindUnit(Единица);
tPreparats.Post;
//а теперь добавляем его в приход
tArrivalDet.Append;
tArrivalDetARRIVAL_ID.Value := tArrivalID.Value;
tArrivalDetPREPARAT_ID.Value := iPrepID;
tArrivalDetUNIT_ID.Value := FindUnit(Единица);
tArrivalDetPRICE_WO_NDS.AsFloat := ЦенаБНДС;
tArrivalDetPRICE_W_VAT.AsFloat := ЦенаСНДС;
tArrivalDetVAT.AsFloat := НДС;
tArrivalDetPRICE_RETAIL.AsFloat := RoundPrice(RoundTo(ЦенаСНДС * fmNewArrival.ceCoeff.Value,-2));
tArrivalDetAMOUNT.Value := StrToFloatDef(DelProb(VarToStr(WorkSheet.Cells.Item[iNameRow,sAmountCol].Value)),0);
tArrivalDetUNIT_ID.Value := FindUnit(Единица);
tArrivalDetSERIES.AsString := Серия;
tArrivalDet.Post;
end;
Inc(iNameRow);
pb1.Position := x;
application.ProcessMessages;
if bAbort then Break;
end;//For e:=0 to RowsToCopy do begin
finally
memoErrors.Lines.Add('Завершение импорта...');
dm.tPreparats.EnableControls;
dm.tArrivalDet.EnableControls;
dm.tArrivalDet.BeforeInsert := dm.tArrivalDetBeforeInsert;
dm.tArrivalDet.AfterPost := dm.tArrivalDetAfterPost;
if dm.tArrivalDet.UpdateTransaction.InTransaction then dm.tArrivalDet.UpdateTransaction.Commit;
if DM.tPreparats.UpdateTransaction.InTransaction then DM.tPreparats.UpdateTransaction.Commit;
dm.tArrivalDet.AutoCommit := true;
DM.tPreparats.AutoCommit := true;
memoErrors.Lines.Add('Найдено в справочнике препаратов: '+IntToStr(НайденоВБазе));
memoErrors.Lines.Add('Добавлено новых в справочник препаратов: '+IntToStr(НеНайденоВБазе));
memoErrors.Lines.Add('Импорт завершен');
StatusBar1.Panels[0].Text := 'Импорт завершен';
Screen.Cursor := crDefault;
end;
end;
|
| Код |
Function TfmImpExcel.Find(sText:String;Var iRow:Integer;Var sCol:String;WorkSheetF:_WorkSheet):Bool;
Var
UsedRange, Range: OLEVariant;
t,y:Integer;//вспомогат для импорта
FirstAddress: string;
begin //поиск начали
Result:=False;
UsedRange := WorkSheetF.Range['A1','Z5000'];//диапазон поиска, напрмер от 'F25' до 'G30'
Range := UsedRange.Find(What:=sText, LookIn := xlValues, LookAt := xlWhole,SearchDirection := xlNext);
if not VarIsClear(Range) then begin
try
FirstAddress := Range.Address;
//вычисляем номер строки из полученного адреса(абсолютные координаты)
//он начинается после второго значка доллара
//формат найденной строки,что-то типа $A$2 (абсолютные координаты)
t:=PosEx('$',FirstAddress,2);
iRow:=StrToInt(Copy(FirstAddress,t+1,length(FirstAddress)-t));
//вычисляем номер столбца из полученного адреса(абсолютные координаты)
//буква начинается со второго символа
y:=PosEx('$',FirstAddress,2);
sCol:=Copy(FirstAddress,2,y-2);
Result:=true;
VarClear(Range);
VarClear(UsedRange);
except
Result:=False;
end;//try-except
end;//if
end;
|
|
Начался отбор тем для DRKB 3.0 
Загрузка ...
*щёлк*
