экспорт данных из stringGrid в excel Опции

[Sanya01078]

есть функция

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; 

Проблема в том что она сохраняет числа без запятой то есть у меня в stringGride число 6,33 а оно сохраняет 6 33 Подскажите где что-то не так!!

[Sanya01078]

Вот примерно так выглядит весь проект!

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;

Сообщение отредактировано: Sanya01078 - 26.04.2010 15:21