Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Делфи _ экспорт данных из stringGrid в excel

Автор: Sanya01078 25.04.2010 16:00

есть функция

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 25.04.2010 16:36

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

Автор: Sanya01078 25.04.2010 16:49

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

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

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

Автор: volvo 25.04.2010 17:43

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

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 25.04.2010 17:55

 
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;


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

Автор: volvo 26.04.2010 2:35

Цитата
выдает ошибку
Project Project2.exe raised exception class EOleException with message 'Нельзя установить свойство NumberFormat класса Range'.
Если б я не проверив, написал прямо сюда - может быть и поверил бы тебе. Но нет, я ж как раз копировал из окна Дельфи, после того как все откомпилировалось, запустилось и отработало.

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

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

Автор: Sanya01078 26.04.2010 12:49

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

Автор: Client 26.04.2010 15:14

лучше прикрепи проект smile.gif

Автор: Sanya01078 26.04.2010 15:20

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

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;

Автор: Client 26.04.2010 15:22

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

Автор: Sanya01078 26.04.2010 15:26

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


Прикрепленные файлы
Прикрепленный файл  Программа.rar ( 241.86 килобайт ) Кол-во скачиваний: 298

Автор: Client 26.04.2010 16:04

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


Эскизы прикрепленных изображений
Прикрепленное изображение

Автор: Sanya01078 26.04.2010 16:10

Цитата

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

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

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

Автор: volvo 26.04.2010 17:25

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

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

Автор: Sanya01078 26.04.2010 20:26

Цитата

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

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