Excel to StringGrid - есть проблема

alexanderkryvda · #1 16.01.2012, 18:51

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

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

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты