перенести данные из таблицы excel в другую таблицу excel
Daria © (2005-12-14 11:28:00)
Привет всем!!!
мне нужно строки из одной таблицы по определенносму признаку
перенести в другую таблицу(сначала создать ее). я пробовала так, но
сохраняется только последняя строка. что делать???
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms,
DB, StdCtrls, DBCtrls, ADODB,ComObj, OleServer,
Excel2000, Types, StrUtils,Dialogs;
function FillExcelList(FileName : String; BegRow, EndRow,
TestCol : Integer) : String;
implementation
function FillExcelList(FileName : String; BegRow, EndRow,
TestCol : Integer) : String;
var ApplicationName,filename0 : String;
Save_Cursor:TCursor;
ExcelApplication : Variant;
RowNo,i,j,n : Integer;
CellValue : String;
Errors : String;
Excel, WorkBook, Sheet: Variant;
begin
Save_Cursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
Result := '';
Errors := '';
ApplicationName := 'Excel.Application';
ExcelApplication := Null;
try
ExcelApplication := CreateOleObject(ApplicationName);
except
on E : Exception do begin
Result :=
'Îøèáêà
ïðè
ñîçäàíèè
ýêçåìïëÿðà
Excel : ' + E.Message;
Exit;
end;
end;
try
try
ExcelApplication.Visible := false;
ExcelApplication.DisplayAlerts := False;
ExcelApplication.WorkBooks.Open(FileName);
for RowNo := BegRow to EndRow do begin
try
CellValue :=
Trim(ExcelApplication.WorkBooks[1].WorkSheets[1].Cells[RowNo,
TestCol].Value);
if ((CellValue '') and (CellValue
'0'))
then begin
for i := 1 to 11 do begin
ExcelApplication.WorkBooks[1].WorkSheets[1].Cells[RowNo,
i].Interior.Colorindex := 3;
end;
end;
if cellvalue='прамввв' then begin
n:=3;
for j:=1 to 11 do begin
Excel.WorkBooks[1].WorkSheets[1].Cells[n,j].value:=
ExcelApplication.WorkBooks[1].WorkSheets[1].Cells[RowNo,j].value;
end;
n:=n+1;
end;
except
on E : Exception do begin
Errors := Errors
+
'Îøèáêà
ïðè
ïîëó÷åíèè
ÿ÷åéêè
['+IntToStr(RowNo)+', '+IntToStr(TestCol)+'] : '
+ E.Message
+ #13#10;
end;
end;
end;
except
on E : Exception do begin
Errors := Errors
+
'Îøèáêà
ïðè
ïîëó÷åíèè
äàííûõ
: '
+ E.Message
+ #13#10;
end;
end;
finally
ExcelApplication.Workbooks[1].Save;
ExcelApplication.Workbooks[1].Close;
ExcelApplication.Quit;
ExcelApplication := Unassigned;
if (Result '') then ShowMessage(Result);
if Length(Errors) > 0 then Result := Errors;
end;
Screen.Cursor := Save_Cursor;
end;
end.
umbra (2005-12-14 11:46:00) [1]
а где эта другая таблица находится?
Наверх 
ЧАТ |
Орешник |
|
