11.11.2013, 14:40
|
Прохожий
|
|
Регистрация: 13.09.2013
Сообщения: 3
Версия Delphi: delphi7
Репутация: 10
|
|
исправить код
есть программа работающая со StringGrid и Excel.Помогите исправить код чтобы она работала StringGrid и OpenOffice(calc).С OpenOffice(calc) сталкиваюсь впервые.
вот код импорта в Excel
Код:
function SgToExcel(aSg : TStringGrid; aExSh : Variant; const aCol : Integer) : Variant;
const
xlCellTypeLastCell = 11;
var
exCell, exRng : Variant;
vArr : Variant;
i, j, Row : Integer;
begin
Result := Unassigned;
vArr := VarArrayCreate([1, aSg.RowCount, 1, aSg.ColCount], varOleStr);
for i := 1 to aSg.RowCount do
for j := 1 to aSg.ColCount do
vArr[i, j] := aSg.Cells[j - 1, i-1];
Row := aExSh.UsedRange.SpecialCells(xlCellTypeLastCell).Row;
exCell := aExSh.Cells[Row, aCol];
exRng := aExSh.Range[exCell,exCell.Offset[aSg.RowCount - aSg.FixedRows - 2, aSg.ColCount - 1]];
exRng.Value := vArr;
Result := exRng;
end;
procedure TForm7.Button1Click(Sender: TObject);
const
xlThin = 2;
xlMedium = -4138;
xlContinuous = 1;
var
exApp, exBook, exSh, exRng : Variant;
i : Integer;
Sg : TStringGrid;
Od : TOpenDialog;
begin
Sg := StringGrid1;
Od := OpenDialog1; //OpenDialog1
if Od.InitialDir = '' then
Od.InitialDir := ExtractFilePath( ParamStr(0) );
if not Od.Execute then Exit;
if FileExists(Od.FileName) then begin
i := MessageBox(0, PChar('Файл с заданным именем уже существует.'
+ ' Его данные будут изменены. Продолжить?'),
'Перезаписать?', MB_YESNO + MB_ICONQUESTION + MB_APPLMODAL);
if i <> IDYES then Exit;
end;
try
exApp := CreateOleObject('Excel.Application');
except
MessageBox(0, 'Не удалось запустить MS Excel. Действие отменено.',
'Ошибка', MB_OK + MB_ICONERROR + MB_APPLMODAL);
Exit;
end;
exApp.Visible := True;
if FileExists(Od.FileName) then
exBook := exApp.WorkBooks.Open(FileName:=Od.FileName)
else
exBook := exApp.WorkBooks.Add;
exSh := exBook.Worksheets[1];
exApp.ScreenUpdating := False;
try
exRng := SgToExcel(Sg, exSh, 1);
if not VarIsClear(exRng) then begin
exRng.Borders.LineStyle := xlContinuous;
exRng.Borders.Weight := xlThin;
exRng.Columns.AutoFit;
end;
finally
exApp.ScreenUpdating := True;
end;
exApp.DisplayAlerts := False;
try
exBook.SaveAs(FileName:=Od.FileName);
finally
exApp.DisplayAlerts := True;
end;
//exBook.Close;
//exApp.Quit;
end;
вот код экспорта с Excel
Код:
procedure ExcelToSg(aExSh : Variant; const aRow, aCol : Integer; aSg : TStringGrid);
const
xlCellTypeLastCell = 11;
var
exRng, exCell1, exCell2 : Variant;
vArr : Variant;
i, j : Integer;
// Row : Integer;
begin
SgClear(aSg);
exCell1 := aExSh.Cells[aRow, aCol];
exCell2 := aExSh.UsedRange.SpecialCells(xlCellTypeLastCell);
if (exCell2.Row < exCell1.Row) or (exCell2.Column < exCell1.Column) then
Exit;
exRng := aExSh.Range[exCell1,
exCell1.Offset[exCell2.Row - exCell1.Row, aSg.ColCount - 1]];
vArr := exRng.Value;
aSg.RowCount := aSg.FixedRows + VarArrayHighBound(vArr, 1);
// Row := aSg.FixedRows;
for i := 1 to VarArrayHighBound(vArr, 1) do
for j := 1 to VarArrayHighBound(vArr, 2) do
aSg.Cells[j ,i ] := vArr[i, j];
end;
procedure TForm8.Button1Click(Sender: TObject);
var
exApp, exBook, exSh : Variant;
Sg : TStringGrid;
Od : TOpenDialog;
begin
StringGrid1.ColCount:=26;
StringGrid1.ColWidths[1]:=20;
StringGrid1.ColWidths[2]:=100;
StringGrid1.ColWidths[3]:=85;
StringGrid1.ColWidths[4]:=100;
StringGrid1.ColWidths[5]:=85;
StringGrid1.ColWidths[6]:=110;
StringGrid1.ColWidths[7]:=85;
StringGrid1.ColWidths[14]:=85;
StringGrid1.ColWidths[23]:=85;
StringGrid1.ColWidths[24]:=95;
StringGrid1.ColWidths[25]:=95;
Sg := StringGrid1;
Od := OpenDialog1; //OpenDialog1
if Od.InitialDir = '' then
Od.InitialDir := ExtractFilePath( ParamStr(0) );
if not Od.Execute then Exit;
if not FileExists(Od.FileName) then begin
MessageBox(0, 'Файл с заданным именем не найден. Действие отменено.'
,'Файл не найден', MB_OK + MB_ICONEXCLAMATION + MB_APPLMODAL);
Exit;
end;
try
exApp := CreateOleObject('Excel.Application');
except
MessageBox(0, 'Не удалось запустить MS Excel. Действие отменено.',
'Ошибка', MB_OK + MB_ICONERROR + MB_APPLMODAL);
Exit;
end;
exApp.Visible := True;
exBook := exApp.WorkBooks.Open(FileName:=Od.FileName);
exSh := exBook.Worksheets[1];
ExcelToSg(exSh, 1, 2, Sg);
end;
|