Форум: "Начинающим";
Текущий архив: 2006.01.01;
Скачать: [xml.tar.bz2];
Внизперенести данные из таблицы excel в другую таблицу excel Найти похожие ветки
← →
Daria (2005-12-14 11:28) [0]Привет всем!!!
мне нужно строки из одной таблицы по определенносму признаку перенести в другую таблицу(сначала создать ее). я пробовала так, но сохраняется только последняя строка. что делать???
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) [1]а где эта другая таблица находится?
Страницы: 1 вся ветка
Форум: "Начинающим";
Текущий архив: 2006.01.01;
Скачать: [xml.tar.bz2];
Память: 0.46 MB
Время: 0.01 c