[alexanderkryvda]

Доброго времени суток, уважаемые форумчане! Прошу Вашей помощи, т.к. уже долго борюсь с одной проблемой:
- "собрал" прогу в которой задумывается сохранение грида в 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.

Сегодня "поигрался" и с ошибкой вроде справился, НО вот что получается теперь при "загрузке" таблицы