есть функция
function saveasexcelfile(stringgrid: tstringgrid; filename: string): boolean;
const
xlwbatworksheet = -4167;
var
row, col: integer;
gridprevfile: string;
xlapp, sheet: olevariant;
begin
result := false;
xlapp := createoleobject('excel.application');
try
xlapp.visible := false;
xlapp.workbooks.add(xlwbatworksheet);
sheet := xlapp.workbooks[1].worksheets[1];
sheet.name := 'my sheet name';
for col := 0 to stringgrid.colcount - 1 do
for row := 0 to stringgrid.rowcount - 1 do
sheet.cells[row + 1, col + 1] := stringgrid.cells[col, row];
try
xlapp.workbooks[1].saveas(filename);
result := true;
except
// error ?
end;
finally
if not varisempty(xlapp) then
begin
xlapp.displayalerts := false;
xlapp.quit;
xlapp := unassigned;
sheet := unassigned;
end;
end;
end;
procedure tform1.button1click(sender: tobject);
begin
if saveasexcelfile(stringgrid1, 'c:\myexcelfile.xls') then
showmessage('stringgrid saved!');
end;
Открой полученный XLS, и посмотри, какой формат имеют ячейки с записанными в них данными... Особенно - те, что отображаются неправильно (Format -> Cells). Может понадобиться изменить NumberFormat ячейки перед тем, как писать в нее данные.
Я извиняюсь может это и банально! Но не подскажете как переделать! Как переделать формат ячеек?
На тех что пишутся 63,22 когда наводишь есть выбор как сохранить!!!
а на тех что 6,777 нечего нету!!
И еще есть такое что если после запятой два числа все нормально а если 3 и более то не ставит запятую!!!
Я уже пытался пере сохранить сделать в самом екселе но не получается когда загружаю в стрингрид все равно после запятой почему то 3 знака! как от этого избавиться?
Добавлено через 7 мин.
о вот еще только что сделал что во втором стирнггриде после перещетов матрицы поставил вывести данные флаот то стр Ф и поставил формат ффФиксед =2 сохранило нормально, а если вам нетрудно как сделать чтобы и
заносимую таблицу из файла отформатировать??
Добавлено через 6 мин.
Спасибо за помощь все я уже нашел!!! Проблему! Я просто при выгрузки таблицы в гринд поставил формат ячеек и все нормально!! И если вас не затруднит еще 1 вопрос а можно сделать что бы не 2 знака после запятой а 3 нормально сохранялось??
Слушай, я не понимаю твоих объяснений, воспроизвести проблему не могу:
for col := 0 to stringgrid.colcount - 1 do
for row := 0 to stringgrid.rowcount - 1 do
begin
sheet.cells[row + 1, col + 1].NumberFormat := 'General';
sheet.cells[row + 1, col + 1] := stringgrid.cells[col, row];
end;
for col := 0 to stringgrid.colcount - 1 do
for row := 0 to stringgrid.rowcount - 1 do
begin
sheet.cells[row + 1, col + 1].NumberFormat := 'General';
sheet.cells[row + 1, col + 1] := stringgrid.cells[col, row];
end;
function xls_to_stringgrid(agrid: tstringgrid; axlsfile: string): 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[1];
sheet.cells.specialcells(xlcelltypelastcell, emptyparam).activate;
x := xlapp.activecell.row;
y := xlapp.activecell.column;
agrid.rowcount := x+1;
agrid.colcount := y+1;
rangematrix := xlapp.range['a1', xlapp.cells.item[x, y]].value;
k := 1;
repeat
for r := 1 to y do
agrid.cells[(r ), (k )] := rangematrix[k, r];
inc(k, 1);
agrid.rowcount := k;
until k > x;
rangematrix := unassigned;
finally
if not varisempty(xlapp) then
begin
xlapp.quit;
xlapp := unassigned;
sheet := unassigned;
result := true;
end;
end;
end;
function SaveAsExcel(AGrid: tstringgrid; filename: string): boolean;
const
xlwbatworksheet = -4167;
var
row, col: integer;
xlapp, sheet: olevariant;
begin
result := false;
xlapp := createoleobject('excel.application');
try
xlapp.visible := false;
xlapp.workbooks.add(xlwbatworksheet);
sheet := xlapp.workbooks[1].worksheets[1];
sheet.name := 'Лист_1';
for col := 1 to AGrid.colcount - 1 do
for row := 1 to AGrid.rowcount - 1 do begin
sheet.cells[row + 1, col + 1].NumberFormat:='General';
sheet.cells[row + 1, col + 1] := AGrid.cells[col, row];
end;
try
xlapp.workbooks[1].saveas(FileName);
result := true;
except
// error ?
end;
finally
if not varisempty(xlapp) then
begin
xlapp.displayalerts := false;
xlapp.quit;
xlapp := unassigned;
sheet := unassigned;
end;
end;
end;
procedure TForm1.ButtonOpenClick(Sender: TObject);
begin
OpenDialog1.Filter:='*.xls';
if not OpenDialog1.Execute then exit;
Label2.Caption:=OpenDialog1.FileName;
if xls_to_stringgrid(MainStrGrid,Label2.Caption) then
showmessage('Таблица открыта!');
end;
procedure TForm1.ButtonSaveAsClick(Sender: TObject);
begin
if not SaveDialog1.Execute then EXIT;
FileName:=SaveDialog1.FileName;
Caption:=FileName;
try
SaveAsExcel(mainStrGrid,FileName);
ShowMessage('Таблица сохранена!');
except
Exit;
end;
end;
Уважаемый volvo я бы если все работало не писал!!
Я работаю на Delphi 7 + WindowsXp SP2+ excel2003!
И опять при попытке сохранить с данными процедурами выскакивает та же ошибка!
Если хотите я вам скину весь проект!!
лучше прикрепи проект
Вот примерно так выглядит весь проект!
unit mainUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, ComCtrls, StdCtrls, Menus,OleServer,comobj,clipbrd,
ImgList, ToolWin, ActnList, StdActns;
type
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
mainStrGrid: TStringGrid;
ButtonOpen: TButton;
ButtonSaveAs: TButton;
MainMenu1: TMainMenu;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
ButtonDelletRow: TButton;
Label1: TLabel;
Label2: TLabel;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
TabSheet2: TTabSheet;
StrGRascheti: TStringGrid;
ButtonReloadData: TButton;
ButtonVichesleniya: TButton;
N7: TMenuItem;
N8: TMenuItem;
Label3: TLabel;
Edit1: TEdit;
Memo1: TMemo;
Button1: TButton;
Edit2: TEdit;
Edit3: TEdit;
procedure ButtonOpenClick(Sender: TObject);
procedure ButtonSaveAsClick(Sender: TObject);
procedure ButtonDelletRowClick(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure mainStrGridKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure ButtonVichesleniyaClick(Sender: TObject);
procedure ButtonReloadDataClick(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
procedure DoClipbrdPaste;
procedure Minimym(min:real; var i1min, i2min: integer; kol_klasterow :integer );
Procedure MatricaPerewet(jEnd, kol_klasterow:integer);
{ Private declarations }
public
{ Public declarations }
end;
type
klas_object= record
znach:array[1..100] of real;
klaster:integer;
h:integer;
end;
var
Form1: TForm1;
FileName:TFileName;
iEnd, jEnd : integer;
mas:array [1..1000] of klas_object;
klas:array [1..1000,1..1000] of real;
mas2:array [1..1000,1..1000]of real;
n,x,y:integer;
sum_centr: real;
implementation
uses Dendro;
{$R *.dfm}
function xls_to_stringgrid(agrid: tstringgrid; axlsfile: string): 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[1];
sheet.cells.specialcells(xlcelltypelastcell, emptyparam).activate;
x := xlapp.activecell.row;
y := xlapp.activecell.column;
agrid.rowcount := x;
agrid.colcount := y+1;
rangematrix := xlapp.range['a1', xlapp.cells.item[x, y]].value;
k := 1;
repeat
for r := 1 to y do
agrid.cells[(r ), (k )] := rangematrix[k, r];
inc(k, 1);
agrid.rowcount := k;
until k > x;
rangematrix := unassigned;
finally
if not varisempty(xlapp) then
begin
xlapp.quit;
xlapp := unassigned;
sheet := unassigned;
result := true;
end;
end;
end;
function SaveAsExcel(AGrid: tstringgrid; filename: string): boolean;
const
xlwbatworksheet = -4167;
var
row, col: integer;
xlapp, sheet: olevariant;
begin
result := false;
xlapp := createoleobject('excel.application');
try
xlapp.visible := false;
xlapp.workbooks.add(xlwbatworksheet);
sheet := xlapp.workbooks[1].worksheets[1];
sheet.name := 'Лист_1';
for col := 1 to AGrid.colcount do
for row := 1 to AGrid.rowcount do begin
sheet.cells[row + 1, col + 1]:= AGrid.cells[col, row];
end;
try
xlapp.workbooks[1].saveas(FileName);
result := true;
except
// error ?
end;
finally
if not varisempty(xlapp) then
begin
xlapp.displayalerts := false;
xlapp.quit;
xlapp := unassigned;
sheet := unassigned;
end;
end;
end;
procedure TForm1.ButtonOpenClick(Sender: TObject);
begin
OpenDialog1.Filter:='*.xls';
if not OpenDialog1.Execute then exit;
Label2.Caption:=OpenDialog1.FileName;
if xls_to_stringgrid(MainStrGrid,Label2.Caption) then
showmessage('Таблица открыта!');
end;
procedure TForm1.ButtonSaveAsClick(Sender: TObject);
begin
if not SaveDialog1.Execute then EXIT;
FileName:=SaveDialog1.FileName;
Caption:=FileName;
try
SaveAsExcel(mainStrGrid,FileName);
ShowMessage('Таблица сохранена!');
except
Exit;
end;
end;
procedure TForm1.ButtonDelletRowClick(Sender: TObject);
var
i,j: Integer;
begin
j:=MainStrGrid.Row;
MainStrGrid.Rows[j].Clear;
for i:=j to MainStrGrid.RowCount-2 do
MainStrGrid.Rows[i].Assign(MainStrGrid.Rows[i+1]);
MainStrGrid.RowCount:=MainStrGrid.RowCount-2;
end;
procedure TForm1.N5Click(Sender: TObject);
begin
close;
end;
procedure TForm1.N3Click(Sender: TObject);
begin
ButtonSaveAs.Click;
end;
procedure TForm1.N2Click(Sender: TObject);
begin
ButtonOpen.Click;
end;
procedure TForm1.FormShow(Sender: TObject);
var
i:integer;
begin
for i:=1 to 1000 do
begin
mainStrGrid.Cells[0,i]:=IntToStr(i);
mainStrGrid.Cells[i,0]:='Ф'+IntToStr(i);
StrGRascheti.Cells[0,i]:=IntToStr(i);
StrGRascheti.Cells[i,0]:='Ф'+IntToStr(i);
end;
end;
procedure TForm1.DoClipbrdPaste;
var
ClipbrdData: TStringList;
ClipbrdRow: TStringList;
i, j, RowCnt: Integer;
begin
if not Clipboard.HasFormat(CF_TEXT) then Exit;
ClipbrdData := TStringList.Create;
ClipbrdRow := TStringList.Create;
try
ClipbrdData.Text := Clipboard.AsText;
RowCnt := ClipbrdData.Count;
// если не вмещается, увеличиваем число строк в StringGrid
if mainStrGrid.RowCount - mainStrGrid.Row < RowCnt then
mainStrGrid.RowCount := RowCnt + mainStrGrid.Row;
for i := 0 to RowCnt - 1 do
begin
ClipbrdData.Strings[i] := '"' + ClipbrdData.Strings[i] + '"';
ClipbrdData.Strings[i] := StringReplace(ClipbrdData.Strings[i], #9,
'"'#9'"', [rfReplaceAll]);
end;
ClipbrdRow.Delimiter := #9;
ClipbrdRow.DelimitedText := ClipbrdData.Strings[0];
// проверяем число столбцов в StringGrid. Если что, добавляем
if mainStrGrid.ColCount - mainStrGrid.Col < ClipbrdRow.Count then
mainStrGrid.ColCount := ClipbrdRow.Count + mainStrGrid.Col;
for i := 0 to RowCnt - 1 do
begin
ClipbrdRow.DelimitedText := ClipbrdData.Strings[i];
for j := 0 to ClipbrdRow.Count - 1 do
mainStrGrid.Cells[j + mainStrGrid.Col, i + mainStrGrid.Row] := ClipbrdRow.Strings[j];
end;
finally
ClipbrdData.Free;
ClipbrdRow.Free;
end;
end;
// вставка в StringGrid по нажатию в нём Ctrl+V
procedure TForm1.mainStrGridKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if ((Key = 86) or (Key = 112)) and (ssCtrl in Shift) then DoClipbrdPaste();
end;
а закинуть папку с проектом в архив и залить? никому не захочется на форму все компоненты кидать
Вот вам и весь проект!
Прикрепленные файлы
Программа.rar ( 241.86 килобайт )
Кол-во скачиваний: 298
погонял проект.
если в стирнггриде вводить через точку то и будут тебе числа, через запятую - не числа.
С 2007 офисом не работает, сохранял как 97-2003.
Итог - все норм.
И 1000*1000 размер - не хорошо. Сколько в екселе столбцов?
Эскизы прикрепленных изображений