Excel to StringGrid - есть проблема
Доброго времени суток, уважаемые форумчане! Прошу Вашей помощи, т.к. уже долго борюсь с одной проблемой:
- "собрал" прогу в которой задумывается сохранение грида в excel и обратно;
- сохраняет нормально, но вот с открытием проблема... (ругается на "неверный индекс"
Скидываю код - если кто сможет - ПОМОГИТЕ решить данную проблему
Код:
......
var
Form4: TForm4;
r,d: textfile;
n,t:byte;
t1,t3,x,y,temp: integer;
t2,t4,tempstr,f: string;
w1,w2,w3,w4, w5, w6, w7, w8, w9: double;
iRow: integer;
vRow: integer;
Line, PosActual: Integer;
Row: TStringList;
Renglon :TStringList;
implementation
uses Unit1, Unit14
{$R *.dfm}
procedure TForm4.FormCreate(Sender: TObject);
begin
t:=1;
t1:=1;
t3:=Form4.sg1.RowCount;
end;
procedure TForm4.Button1Click(Sender: TObject);
begin
Form4.Gauge1.Visible:=true;
n:=Form4.sg1.RowCount-1;
t4:=IntToStr(t3);
Form4.sg1.Cells[0,n]:=t4;
.......
Form4.sg1.Cells[19,n]:=edit11.Text;
t2:=IntToStr(t1);
t1:=t1+1;
t3:=t3+1;
Form4.sg1.RowCount:=Form4.sg1.RowCount+1;
Form4.Gauge1.Progress:=Form4.Gauge1.Progress+16;
end;
procedure TForm4.Button12Click(Sender: TObject);
begin
Form4.Edit1.Text:='';
Form4.Edit2.Text:='';
Form4.Edit3.Text:='';
Form4.Edit14.Text:='';
Form4.Edit15.Text:='';
Form4.Edit4.Text:='';
Form4.Edit8.Text:='';
Form4.Edit9.Text:='';
Form4.Edit5.Text:='';
Form4.Edit6.Text:='';
Form4.combobox2.Text:='';
Form4.Edit7.Text:='';
end;
procedure TForm4.sg1Click(Sender: TObject);
begin
Form14.Edit1.Text:=Form4.sg1.Cells[1,n];
Form14.edit2.Text:=Form4.sg1.Cells[2,n];
Form14.edit3.Text:=Form4.sg1.Cells[3,n];
Form14.edit4.Text:=Form4.sg1.Cells[4,n];
Form14.edit5.Text:=Form4.sg1.Cells[5,n];
Form14.edit6.Text:=Form4.sg1.Cells[6,n];
Form14.Edit7.Text:=Form4.sg1.Cells[7,n];
Form14.Edit15.Text:=Form4.sg1.Cells[8,n];
Form14.Edit8.Text:=Form4.sg1.Cells[9,n];
Form14.Edit9.Text:=Form4.sg1.Cells[10,n];
Form14.Edit10.Text:=Form4.sg1.Cells[11,n];
Form14.Edit11.Text:=Form4.sg1.Cells[12,n];
Form14.Edit12.Text:=Form4.sg1.Cells[13,n];
Form14.Edit13.Text:=Form4.sg1.Cells[14,n];
Form14.Edit14.Text:=Form4.sg1.Cells[15,n];
end;
procedure XlsWriteCellLabel(XlsStream: TStream; const ACol, ARow: Word;
const AValue: string);
var
L: Word;
const
{$J+}
CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
{$J-}
begin
L := Length(AValue);
CXlsLabel[1] := 8 + L;
CXlsLabel[2] := ARow;
CXlsLabel[3] := ACol;
CXlsLabel[5] := L;
XlsStream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
XlsStream.WriteBuffer(Pointer(AValue)^, L);
end;
function SaveAsExcelFile(AGrid: TStringGrid; AFileName: string): Boolean;
const
{$J+} CXlsBof: array[0..5] of Word = ($809, 8, 00, $10, 0, 0); {$J-}
CXlsEof: array[0..1] of Word = ($0A, 00);
var
FStream: TFileStream;
I, J: Integer;
begin
//Result := False;
FStream := TFileStream.Create(PChar(AFileName), fmCreate or fmOpenWrite);
try
CXlsBof[4] := 0;
FStream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
for i := 0 to AGrid.ColCount - 1 do
for j := 0 to AGrid.RowCount - 1 do
XlsWriteCellLabel(FStream, I, J, AGrid.cells[i, j]);
FStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
Result := True;
finally
FStream.Free;
end;
end;
procedure TForm4.Button4Click(Sender: TObject);
{if SaveAsExcelFile(Form4.sg1, 'd:\Результаты работы\Result.xls')
then
ShowMessage('Выполнено');}
var
WorkBook, Sheet:variant;
i, j: integer;
FName: string;
XLApp: olevariant;
begin
if SaveDialog1.Execute then
FName := SaveDialog1.FileName
else
Exit;
XLApp:=CreateOleObject('Excel.Application');
XLApp.DisplayAlerts:=False;
XLApp.Visible:= False;
Workbook:=XLApp.
Workbooks.Add;
Workbook.SaveAs(FName);
Sheet:= Workbook.ActiveSheet;
for i:= 0 to form4.sg1.RowCount - 1 do
begin
for j:= 0 to form4.sg1.ColCount - 1 do
Sheet.Cells[i+1, j+1]:= form4.sg1.Cells[j, i];
end;
Workbook.Save;
Workbook.Close;
XLApp.Quit;
XLApp:= UnAssigned;
MessageBox(Handle,'Экспорт данных завершен!','Внимание!',0);
end;
Type TFakeGrid=class(TCustomGrid);
procedure TForm4.Button9Click(Sender: TObject);
begin
TFakeGrid(sg1).DeleteRow(sg1.row);
end;
procedure TForm4.Button13Click(Sender: TObject);
var
k,k1,k3,c: integer;
begin
c:=0;
k3:=0;
form15.sg1.RowCount:=2;
for k:=2 to sg1.RowCount do
for k1:=0 to 18 do k3:=0;
f:=inputbox('Поиск информации','По дате рождения','');
for k:=2 to sg1.RowCount do
if f=sg1.Cells[7,k] then begin
k3:=k3+1;
for k1:=0 to 18 do begin c:=1;
form15.sg1.Cells[k1,k3]:=form4.sg1.Cells[k1,k];
end;
form15.sg1.RowCount:=form15.sg1.RowCount+1;
end;
if c=0 then begin Showmessage('Извините, по Вашему запросу ничего не найдено! Пожалуйста уточните запрос');
end;
end;
procedure TForm4.Button2Click(Sender: TObject); //по фамилии
var
k,k1,k3,c: integer;
begin
c:=0;
k3:=0;
form15.sg1.RowCount:=2;
for k:=2 to sg1.RowCount do
for k1:=0 to 18 do k3:=0;
f:=inputbox('Поиск информации','По Фамилии','');
for k:=2 to sg1.RowCount do
if f=sg1.Cells[1,k] then begin
k3:=k3+1;
for k1:=0 to 18 do begin c:=1;
form15.sg1.Cells[k1,k3]:=form4.sg1.Cells[k1,k];
end;
form15.sg1.RowCount:=form15.sg1.RowCount+1;
end;
if c=0 then begin Showmessage('Извините, по Вашему запросу ничего не найдено! Пожалуйста уточните запрос');
end;
end;
procedure TForm4.Button6Click(Sender: TObject);
var
k,k1,k3,c: integer;
begin
c:=0;
k3:=0;
form15.sg1.RowCount:=2;
for k:=2 to sg1.RowCount do
for k1:=0 to 18 do k3:=0;
f:=inputbox('Поиск информации','По дате рождения','');
for k:=2 to sg1.RowCount do
if f=sg1.Cells[4,k] then begin
k3:=k3+1;
for k1:=0 to 18 do begin c:=1;
form15.sg1.Cells[k1,k3]:=form4.sg1.Cells[k1,k];
end;
form15.sg1.RowCount:=form15.sg1.RowCount+1;
end;
if c=0 then begin Showmessage('Извините, по Вашему запросу ничего не найдено! Пожалуйста уточните запрос');
end;
end;
procedure TForm4.Button7Click(Sender: TObject);
var
k,k1,k3,c: integer;
begin
c:=0;
k3:=0;
form15.sg1.RowCount:=2;
for k:=2 to sg1.RowCount do
for k1:=0 to 18 do k3:=0;
f:=inputbox('Поиск информации','По дате рождения','');
for k:=2 to sg1.RowCount do
if f=sg1.Cells[13,k] then begin
k3:=k3+1;
for k1:=0 to 18 do begin c:=1;
form15.sg1.Cells[k1,k3]:=form4.sg1.Cells[k1,k];
end;
form15.sg1.RowCount:=form15.sg1.RowCount+1;
end;
if c=0 then begin Showmessage('Извините, по Вашему запросу ничего не найдено! Пожалуйста уточните запрос');
end;
end;
procedure TForm4.Button11Click(Sender: TObject);
var
k,k1,k3,c: integer;
begin
c:=0;
k3:=0;
form15.sg1.RowCount:=2;
for k:=2 to sg1.RowCount do
for k1:=0 to 18 do k3:=0;
f:=inputbox('Поиск информации','По дате рождения','');
for k:=2 to sg1.RowCount do
if f=sg1.Cells[10,k] then begin
k3:=k3+1;
for k1:=0 to 18 do begin c:=1;
form15.sg1.Cells[k1,k3]:=form4.sg1.Cells[k1,k];
end;
form15.sg1.RowCount:=form15.sg1.RowCount+1;
end;
if c=0 then begin Showmessage('Извините, по Вашему запросу ничего не найдено! Пожалуйста уточните запрос');
end;
end;
procedure TForm4.Button8Click(Sender: TObject);
begin
w1:=StrToFloat(Edit10.Text);
w2:=StrToFloat(Edit11.Text);
w3:=100;
w4:=((w1*w2)/w3);
w5:=w1-w4;
//Label24.Caption:=w4;
Edit12.Text:=FloatToStr(w4);
Edit13.Text:=FloatToStr(w5);
end;
procedure GridSort(StrGrid: TStringGrid; NoColumn: Integer);
var
Line, PosActual: Integer;
Row: TStringList;
Renglon :TStringList;
begin
Renglon := TStringList.Create;
Row := TStringList.Create;
for Line := 1 to StrGrid.RowCount-1 do
begin
PosActual := Line;
Row.Assign(StrGrid.Rows[PosActual]);
while True do
begin
if (PosActual = 0) or
(Row.Strings[NoColumn] >= StrGrid.Cells[NoColumn,PosActual-1])
then break;
StrGrid.Rows[PosActual] := StrGrid.Rows[PosActual-1];
Dec(PosActual);
end;
if (Row.Strings[NoColumn] < StrGrid.Cells[NoColumn,PosActual])
then StrGrid.Rows[PosActual].Assign(Row);
end;
Row.Free;
Renglon.Free;
end;
procedure TForm4.Button21Click(Sender: TObject);
begin
w1:=StrToFloat(Edit10.Text);
w8:=StrToFloat(Edit13.Text);
w3:=100;
w6:=w1/w3;
w7:=w1-w8;
w9:=w7/w6;
Edit12.Text:=FloatToStr(w7);
Edit11.Text:=FloatToStr(w9);
end;
procedure TForm4.Button10Click(Sender: TObject);
begin
if saveasexcelfile(sg1, 'c:\....\Daze.xls') then
showmessage('....');
end;
function Xls_To_StringGrid(AGrid: TStringgrid; AXLSFile: string; i:byte): Boolean;
const
xlCellTypeLastCell = $0000000B;
var
XLApp, Sheet: OLEVariant;
RangeMatrix: Variant;
x, y, k, r: Integer;
begin
Result := False;
XLApp := CreateOleObject('Excel.Application');
try
XLApp.Visible := False;
XLApp.Workbooks.Open(AXLSFile);
Sheet := XLApp.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[i];
Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
x := XLApp.ActiveCell.Row;
y := XLApp.ActiveCell.Column;
AGrid.RowCount := x;
AGrid.ColCount := y;
RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;
k := 1;
repeat
for r := 1 to y do
AGrid.Cells[(r - 1), (k - 1)] := RangeMatrix[K, R];
Inc(k, 1);
AGrid.RowCount := k + 1;
until k > x;
RangeMatrix := Unassigned;
finally
if not VarIsEmpty(XLApp) then
begin
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
Result := True;
end;
end;
end;
procedure TForm4.BitBtn1Click(Sender: TObject);
begin
if xls_to_stringgrid (form4.sg1, 'c:\....\Daze.xls', EmptyParam)
then
showmessage('table has been exported!');
end;
end.
Сегодня "поигрался" и с ошибкой вроде справился, НО вот что получается теперь при "загрузке" таблицы
Последний раз редактировалось alexanderkryvda, 17.01.2012 в 21:42.
|