Творец
Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант
Репутация: 2
Всего: 329
|
Ex1 - компонента со страницы servers, я где-то помечал это, + у меня в USES подключён модуль ExcelXP, и программа нормально работает со всеми версия Excel`я от 97 до 2003 - другие не пробовал. Добавлено @ 14:13 если здесь поискать, http://forum.vingrad.ru/index.php?showforum=89, то можно найти полный код процедуры Добавлено @ 14:18 не пожадничаю и выложу код из похожей моей программы, но код уже переделан в лучшую сторону | Код |
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;
sUnitCol, sAmountCol, sTermCol, sProdCol, sPriceCol, sNameCol, sSeriesCol, sFileName : String;
bNaydeno7, bNaydeno6, bNaydeno5, bNaydeno4, bNaydeno2, bNaydeno1, bNaydeno, bNaydeno3 : boolean;
vPrep:variant;
НайденоВБазе, НеНайденоВБазе:integer;
Препарат, Производитель, Серия, Единица: String;
begin
sFileName := '';
screen.Cursor := crHourGlass;
try
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
//ищем наименование препаратов
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
//показываем кол-во строк для копирования
memoErrors.Lines.Add(TimeToStr(Time)+' Записей для импорта '+IntToStr(RowsToCopy));
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 bNaydeno=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));
Серия := 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 (Препарат = '') or (Препарат = ' ')
then
Inc(iStop)//если пустая строка, то увеличиваем на 1
else
iStop := 0;//если следующая не пустая то обнуляем и продолжаем импорт
//если начались пустые строки то прекращаем импорт
if iStop > 4 then break;
//наименование препарата сначала нужно найти в справочнике препаратов
if FindPreparat(Препарат, Серия, Производитель, iPrepID)
then
begin//если нашли, то у нас есть его ID, т.е. iPrepID
//добавляем в приход
Inc(НайденоВБазе);
tArrivalDet.Append;
tArrivalDetPREPARAT_ID.Value := iPrepID;
if cbWithVAT.state = cbsUnchecked then
begin
tArrivalDetPRICE_WO_NDS.AsFloat := StrToFloatDef(DelProb(VarToStr(WorkSheet.Cells.Item[iNameRow,sPriceCol].Value)),0);
tArrivalDetW_VAT.Value := False;
end
else
begin
tArrivalDetPRICE_WO_NDS.AsFloat := StrToFloatDef(DelProb(VarToStr(WorkSheet.Cells.Item[iNameRow,sPriceCol].Value)),0) * 1.2;
tArrivalDetW_VAT.Value := True;
end;
tArrivalDetPRICE_RETAIL.AsFloat := StrToFloatDef(DelProb(VarToStr(WorkSheet.Cells.Item[iNameRow,sPriceCol].Value)),0) * fmNewArrival.ceCoeff.Value;
tArrivalDetAMOUNT.Value := StrToFloatDef(DelProb(VarToStr(WorkSheet.Cells.Item[iNameRow,sAmountCol].Value)),0);
if FindUnit(Единица,iUnitID)
then
tArrivalDetUNIT_ID.Value := iUnitID
else
tArrivalDetUNIT_ID.Value := AddNewUnit(Единица);
tArrivalDet.Post;
end
else
begin//добавляем в справочник препаратов новый препарат
Inc(НеНайденоВБазе);
tPreparats.Append;
iPrepID := tPreparatsID.Value;
tPreparatsNAME.Value := Препарат;
tPreparatsPRODUCER.Value := Производитель;
tPreparatsSERIES.Value := Серия;
tPreparatsPRICE_RETAIL.AsFloat := StrToFloatDef(DelProb(VarToStr(WorkSheet.Cells.Item[iNameRow,sPriceCol].Value)),0) * fmNewArrival.ceCoeff.Value;
tPreparatsTERM.Value := Trim(VarToStr(WorkSheet.Cells.Item[iNameRow,sTermCol].Value));
//а теперь добавляем его в приход
tArrivalDet.Append;
tArrivalDetPREPARAT_ID.Value := iPrepID;
if FindUnit(Единица,iUnitID)
then
tArrivalDetUNIT_ID.Value := iUnitID
else
tArrivalDetUNIT_ID.Value := AddNewUnit(Единица);
tPreparats.Post;
if cbWithVAT.state = cbsUnchecked then
begin
tArrivalDetPRICE_WO_NDS.AsFloat := StrToFloatDef(DelProb(VarToStr(WorkSheet.Cells.Item[iNameRow,sPriceCol].Value)),0);
tArrivalDetW_VAT.Value := False;
end
else
begin
tArrivalDetPRICE_WO_NDS.AsFloat := StrToFloatDef(DelProb(VarToStr(WorkSheet.Cells.Item[iNameRow,sPriceCol].Value)),0) * 1.2;
tArrivalDetW_VAT.Value := True;
end;
tArrivalDetPRICE_RETAIL.AsFloat := StrToFloatDef(DelProb(VarToStr(WorkSheet.Cells.Item[iNameRow,sPriceCol].Value)),0) * fmNewArrival.ceCoeff.Value;
tArrivalDetAMOUNT.Value := StrToFloatDef(DelProb(VarToStr(WorkSheet.Cells.Item[iNameRow,sAmountCol].Value)),0);
if FindUnit(Единица,iUnitID)
then
tArrivalDetUNIT_ID.Value := iUnitID
else
tArrivalDetUNIT_ID.Value := AddNewUnit(Единица);
tArrivalDet.Post;
end;
Inc(iNameRow);
pb1.Position := x;
application.ProcessMessages;
if bAbort then
begin
Break;
end;
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;
Screen.Cursor := crDefault;
memoErrors.Lines.Add('Найдено в базе: '+IntToStr(НайденоВБазе));
memoErrors.Lines.Add('Добавлено новых: '+IntToStr(НеНайденоВБазе));
memoErrors.Lines.Add('Импорт завершен');
end;
end;
|
| Код |
function TfmImpFromExcel.DelProb(prob: string): string;
Var
i:integer;
begin
result:='';
For i:=1 to Length(prob) do begin
if (prob[i] in ['0'..'9']) or (prob[i]=',') or((prob[i]='.')) then result:=result+prob[i];
end;
end;
|
| Код |
Function TfmImpFromExcel.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'];
Range := UsedRange.Find(What:=sText, LookIn := xlValues, LookAt := xlWhole,SearchDirection := xlNext);
if not VarIsClear(Range) then begin
try
FirstAddress := Range.Address;
//вычисляем номер строки из полученного адреса(абсолютные координаты)
//он начинается после второго значка доллара
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;
|
вот "мой" Uses | Код | uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ToolWin, ActnMan, ActnCtrls, XPStyleActnCtrls, ActnList, cxTextEdit,
cxControls, cxContainer, cxEdit, cxMemo, ExcelXP, OleServer, StrUtils,
{, Excel2000{, Excel97, TlHelp32,} ComObj, DB, ComCtrls, DBGridEh, StdCtrls,
Mask, DBCtrlsEh, DBLookupEh, pFIBQuery, PropFilerEh, PropStorageEh, cxCheckBox; |
код импортирует из Excel`я в БД (FireBird) 5-6 тысяч строк (4 столбца) достаточно быстро Это сообщение отредактировал(а) Akella - 25.7.2006, 14:21 |
Delphi + Excel пример с DRKB, У меня не работает? 
Загрузка ...
(с) я, хотя может и нет
