экспорт данных из 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 Подскажите где что-то не так!!

[volvo]

Открой полученный XLS, и посмотри, какой формат имеют ячейки с записанными в них данными... Особенно - те, что отображаются неправильно (Format -> Cells). Может понадобиться изменить NumberFormat ячейки перед тем, как писать в нее данные.

[Sanya01078]

Я извиняюсь может это и банально! Но не подскажете как переделать! Как переделать формат ячеек?
На тех что пишутся 63,22 когда наводишь есть выбор как сохранить!!!
а на тех что 6,777 нечего нету!!
И еще есть такое что если после запятой два числа все нормально а если 3 и более то не ставит запятую!!!
Я уже пытался пере сохранить сделать в самом екселе но не получается когда загружаю в стрингрид все равно после запятой почему то 3 знака! как от этого избавиться?

Добавлено через 7 мин.
о вот еще только что сделал что во втором стирнггриде после перещетов матрицы поставил вывести данные флаот то стр Ф и поставил формат ффФиксед =2 сохранило нормально, а если вам нетрудно как сделать чтобы и
заносимую таблицу из файла отформатировать??

Добавлено через 6 мин.
Спасибо за помощь все я уже нашел!!! Проблему! Я просто при выгрузки таблицы в гринд поставил формат ячеек и все нормально!! И если вас не затруднит еще 1 вопрос а можно сделать что бы не 2 знака после запятой а 3 нормально сохранялось??

[volvo]

Слушай, я не понимаю твоих объяснений, воспроизвести проблему не могу:

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;

прекрасно сохраняет число с любым количеством знаков после запятой (у меня в системе разделитель целой и дробной части - точка, запятая используется для отделения тысяч) :


Естественно, если в Гриде будут не только числа, но и текст - такое работать не будет, надо будет проверять на число (TryStrToFloat), и в зависимости от результата присваивать либо текстовый либо General формат.

[Sanya01078]

 
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;

выдает ошибку
Project Project2.exe raised exception class EOleException with message 'Нельзя установить свойство NumberFormat класса Range'.


Добавлено через 13 мин.
вот выкладываю все функции!!

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;

может это поможет!!

Сообщение отредактировано: Sanya01078 - 25.04.2010 18:12

[volvo]

выдает ошибку
Project Project2.exe raised exception class EOleException with message 'Нельзя установить свойство NumberFormat класса Range'.

Если б я не проверив, написал прямо сюда - может быть и поверил бы тебе. Но нет, я ж как раз копировал из окна Дельфи, после того как все откомпилировалось, запустилось и отработало.

Вот и сейчас. Взял твои процедуры/функции, собрал проект, компилируется, работает, как и показано выше. Что я делаю не так? Тестировалось на Дельфи 2009 + WinXP SP3 + ExcelXP...

Да и вообще:

Нельзя установить свойство NumberFormat класса Range

А где, собственно, работа с классом Range? Я-то работаю с экземпляром Cell, а не Range, уж не знаю, с чем ты работаешь...

[Sanya01078]

Уважаемый volvo я бы если все работало не писал!!
Я работаю на Delphi 7 + WindowsXp SP2+ excel2003!
И опять при попытке сохранить с данными процедурами выскакивает та же ошибка!
Если хотите я вам скину весь проект!!

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

[Client]

лучше прикрепи проект

[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

[Client]

а закинуть папку с проектом в архив и залить? никому не захочется на форму все компоненты кидать

[Sanya01078]

Вот вам и весь проект!

[Client]

погонял проект.
если в стирнггриде вводить через точку то и будут тебе числа, через запятую - не числа.
С 2007 офисом не работает, сохранял как 97-2003.
Итог - все норм.
И 1000*1000 размер - не хорошо. Сколько в екселе столбцов?

[Sanya01078]

И 1000*1000 размер - не хорошо. Сколько в екселе столбцов?

то есть надо сделать меньше?
В самом екселе помоиму более 1000 строк и столбцов!

Добавлено через 3 мин.
Client ОГРОМНОЕ СПАСИБО! И правда когда поставил разделитель дробной части точку все стало на свои места и сохраняет корректно!!
А на счет сколько должно быть указано столбцов и строк не подкскажете?

[volvo]

И правда когда поставил разделитель дробной части точку все стало на свои места и сохраняет корректно!!

Это до тебя только сейчас дошло, то, о чем тебе написали в посте №4? Или ты принципиально читаешь только определенно чьи-то ответы, а всех остальных - игнорируешь, а, умник? Или ты что, считаешь, что я для себя выкладывал скриншот, КАК ДОЛЖНЫ вводиться числа в стринггрид (в том же, четвертом, посте)? Больше вот делать мне нечего, решил сделать скриншот, и выложить, да?

А на счет сколько должно быть указано столбцов и строк не подкскажете?

Иди на MSDN.microsoft.com и читай, как определить количество задействованных строк/столбцов на листе Excel... За тебя это делать никому на фиг не надо. А то опять напишешь тебе, ты опять проигнорируешь, будешь упираться что "не работает", пока кто-нибудь еще не придет и не повторит...

[Sanya01078]

прекрасно сохраняет число с любым количеством знаков после запятой (у меня в системе разделитель целой и дробной части - точка, запятая используется для отделения тысяч) :

В вашем объяснении я не увидел такого совета как поменять разделитель на компьютере!!!
И попрошу будьте более корректней!!
Я читаю все посты и пытаюсь исправить свои ошибки!! Спасибо ВСЕМ за помощь!