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

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

Форум «Всё о Паскале» _ Делфи _ Delphi и Excel

Автор: Atreides 10.03.2010 23:09

Столкнулся с задачкой, переброски данных из приложения в эксель. Взял пример из DRKB, все получилось, только вот проблемка с шириной ячеек, как в экселе сделать форматирование ячеек? И еще приложил скрин формы приложения. там внизу у меня есть пустая строка, туда хотел дописать Итого и сумму по всем значений в 4 столбце, но вот никак не пойму как сделать в гриде у значения типа стриг, и как их просуммировать, в типе реал вроде не понимает точку, вместо запятой. Давно мучает вопрос, как прописать, что бы в поле Edit можно было вводить только 4 цифры и только цифры, а так же сделать проверку на его заполнение, на ссылку типа Null вроде не реагирует.

unit Print_Otch;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls, FMTBcd, rxPlacemnt, SqlExpr, DB, DBClient, ComObj,
Printers;

type
TPrint_Otch_Express = class(TForm)
StringGrid1: TStringGrid;
GroupBox1: TGroupBox;
Button1: TButton;
Button2: TButton;
Button3: TButton;
ComboBox1: TComboBox;
Edit1: TEdit;
Label1: TLabel;
Label2: TLabel;
ClientDataSet1: TClientDataSet;
SQLDataSet1: TSQLDataSet;
FormPlacement1: TFormPlacement;
procedure Button3Click(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Print_Otch_Express: TPrint_Otch_Express;

implementation

uses DM_GL;

{$R *.dfm}

{Function SetColumnWidth (sheet:variant;
column:variant;width:real):boolean;
begin
SetColumnWidth:=true;
try
E.ActiveWorkbook.Sheets.Item[sheet].Columns[column].ColumnWidth:=300;
except
SetColumnWidth:=false;
end;
End; }



procedure TPrint_Otch_Express.Button1Click(Sender: TObject);
var
col, i: integer;
ID_Otchm: string;
MonthSelected, year: string;
st: string;
kodpl, namepl, summa, NumStat: string;
a: real;
b: real;
begin
// decimalSeparator := '.';
year := Print_Otch_Express.Edit1.Text;
MonthSelected := FloatToStr(Print_Otch_Express.ComboBox1.ItemIndex + 1);

ID_Otchm := 'select ID_OTCHM from sprotchmonth where YEAROTCH ' +
'= ' + year + ' and MONTHOTCH = ' + #39 + MonthSelected + #39 + '';

DM_1.CDS1.close;
DM_1.CDS1.DataRequest(ID_Otchm);
DM_1.CDS1.open;
ID_Otchm := DM_1.CDS1.fieldbyname('ID_OTCHM').asstring;

st := 'select pl.kod_plateg_fo7 kodpl, spr.N_STAT_FO7, pl.name_plateg_fo7 namepl,' +
'sum(i.summa) from indatasumma i, spr_plateg_fo7 pl, spr_stat_fo7 spr ' +
'where pl.id_plateg_fo7 = i.id_plateg_fo7 ' +
'and spr.id_stat_fo7 = pl.id_plateg_fo7 ' +
' and i.id_otchm = ' + ID_Otchm + ' ' +
' group by pl.kod_plateg_fo7, pl.name_plateg_fo7,N_STAT_FO7 ' +
' order by Kodpl asc';

DM_1.CDS1.close;
DM_1.CDS1.DataRequest(st);
DM_1.CDS1.open;

col := DM_1.CDS1.RecordCount;
if col = 0 then
begin
ShowMessage('Данные отсуствуют ');
end;
if col <> 0 then
begin
ShowMessage('Загруженно ' + IntToStr(col) + ' записей');
Print_Otch_Express.StringGrid1.RowCount := col + 3;
end;


while not DM_1.CDS1.eof do
begin

for i := 3 to Print_Otch_Express.StringGrid1.RowCount - 1 do
begin

kodpl := DM_1.CDS1.fieldbyname('KODPL').asstring;
namepl := DM_1.CDS1.fieldbyname('NAMEPL').asstring;
summa := DM_1.CDS1.fieldbyname('SUM(i.SUMMA)').asstring;
NumStat := DM_1.CDS1.fieldbyname('N_STAT_FO7').asstring;

Print_Otch_Express.StringGrid1.Cells[0, i] := kodpl;
Print_Otch_Express.StringGrid1.Cells[1, i] := NumStat;
Print_Otch_Express.StringGrid1.Cells[2, i] := namepl;
Print_Otch_Express.StringGrid1.Cells[3, i] := summa;

DM_1.CDS1.next;

end;

DM_1.CDS1.close;
end;

begin
Print_Otch_Express.StringGrid1.RowCount := Print_Otch_Express.StringGrid1.RowCount + 1;
end;
{ Print_Otch_Express.StringGrid1.Cells[2, col + 2] := 'Итого:';
Print_Otch_Express.StringGrid1.Cells[3, col + 2] := FloatToStr(a); }
Print_Otch_Express.StringGrid1.Cells[2, 1] := 'за '+Print_Otch_Express.ComboBox1.Text+'';
end;


//==============================Excel===========================================

function RefToCell(RowID, ColID: Integer): string;
var
ACount, APos: Integer;

begin
ACount := ColID div 26;
APos := ColID mod 26;
if APos = 0 then

begin
ACount := ACount - 1;
APos := 26;
end;

if ACount = 0 then
Result := Chr(Ord('A') + ColID - 1) + IntToStr(RowID);
if ACount = 1 then
Result := 'A' + Chr(Ord('A') + APos - 1) + IntToStr(RowID);
if ACount > 1 then
Result := Chr(Ord('A') + ACount - 1) + Chr(Ord('A') + APos - 1) + IntToStr(RowID);
end;

// Export StringGrid contents to Excel

function StringGridToExcelSheet(Grid: TStringGrid; SheetName, FileName: string;
ShowExcel: Boolean): Boolean;
const
xlWBATWorksheet = -4167;
var
SheetCount, SheetColCount, SheetRowCount, BookCount: Integer;
XLApp, Sheet, Data: OLEVariant;
I, J, N, M: Integer;
SaveFileName: string;

begin

//notwendige Sheetanzahl feststellen
SheetCount := (Grid.ColCount div 256) + 1;
if Grid.ColCount mod 256 = 0 then
SheetCount := SheetCount - 1;
//notwendige Bookanzahl feststellen
BookCount := (Grid.RowCount div 65536) + 1;
if Grid.RowCount mod 65536 = 0 then

BookCount := BookCount - 1;

//Create Excel-OLE Object
Result := False;
XLApp := CreateOleObject('Excel.Application');
try
//Excelsheet anzeigen
if ShowExcel = False then
XLApp.Visible := False
else
XLApp.Visible := True;
//Workbook hinzufugen
for M := 1 to BookCount do
begin
XLApp.Workbooks.Add(xlWBATWorksheet);
//Sheets anlegen
for N := 1 to SheetCount - 1 do
begin
XLApp.Worksheets.Add;
end;
end;
//Sheet ColAnzahl feststellen
if Grid.ColCount <= 256 then
SheetColCount := Grid.ColCount
else
SheetColCount := 256;
//Sheet RowAnzahl feststellen
if Grid.RowCount <= 65536 then
SheetRowCount := Grid.RowCount
else
SheetRowCount := 65536;
//Sheets befullen
for M := 1 to BookCount do
begin
for N := 1 to SheetCount do
begin
//Daten aus Grid holen
Data := VarArrayCreate([1, Grid.RowCount, 1, SheetColCount], varVariant);
for I := 0 to SheetColCount - 1 do
for J := 0 to SheetRowCount - 1 do
if ((I + 256 * (N - 1)) <= Grid.ColCount) and
((J + 65536 * (M - 1)) <= Grid.RowCount) then
Data[J + 1, I + 1] := Grid.Cells[I + 256 * (N - 1), J + 65536 * (M - 1)];
//-------------------------
XLApp.Worksheets[N].Select;
XLApp.Workbooks[M].Worksheets[N].Name := SheetName + IntToStr(N);
//Zellen als String Formatieren
XLApp.Workbooks[M].Worksheets[N].Range[RefToCell(1, 1),
RefToCell(SheetRowCount, SheetColCount)].Select;
XLApp.Selection.NumberFormat := '@';
XLApp.Workbooks[M].Worksheets[N].Range['A1'].Select;
//Daten dem Excelsheet ubergeben
Sheet := XLApp.Workbooks[M].WorkSheets[N];
Sheet.Range[RefToCell(1, 1), RefToCell(SheetRowCount, SheetColCount)].Value := Data;
end;
end;
//Save Excel Worksheet
try
for M := 1 to BookCount do
begin
SaveFileName := Copy(FileName, 1, Pos('.', FileName) - 1) + IntToStr(M) +
Copy(FileName, Pos('.', FileName),
Length(FileName) - Pos('.', FileName) + 1);
XLApp.Workbooks[M].SaveAs(SaveFileName);
end;
Result := True;
except
// Вот оно херачит
end;
finally
//Excel Beenden
if (not VarIsEmpty(XLApp)) and (ShowExcel = False) then

begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
end;
end;
end;



procedure TPrint_Otch_Express.Button2Click(Sender: TObject);
begin
StringGridToExcelSheet(StringGrid1, 'Отчетный месяц', 'С:\Express_othm\ExcelFile.xls', True);
end;
//==============================================================================


procedure TPrint_Otch_Express.Button3Click(Sender: TObject);
begin
Close;
end;


procedure TPrint_Otch_Express.ComboBox1Change(Sender: TObject);
var MonthSelected: Integer;
begin
MonthSelected := Print_Otch_Express.ComboBox1.ItemIndex + 1;
end;



procedure TPrint_Otch_Express.FormCreate(Sender: TObject);
begin
// Print_Otch_Express.StringGrid1.Cells[0, 0] := ' Код Платежа';
//Print_Otch_Express.StringGrid1.Cells[1, 0] := ' Номер Статьи';
Print_Otch_Express.StringGrid1.Cells[2, 0] := 'Отчет разных сборов и прочих '+
'поступлений по пассажирским перевозкам по КБШ ж.д.';


Print_Otch_Express.StringGrid1.Cells[0, 2] := ' Код Платежа';
Print_Otch_Express.StringGrid1.Cells[1, 2] := ' Номер Статьи';
Print_Otch_Express.StringGrid1.Cells[2, 2] := ' ' +
' Наименование платежа';
Print_Otch_Express.StringGrid1.Cells[3, 2] := ' Сумма';



end;


end.






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

Автор: volvo 11.03.2010 0:13

Цитата
только вот проблемка с шириной ячеек, как в экселе сделать форматирование ячеек?


        Sheet.Range['D:D'].Select; // Здесь тот столбец (можно - область), который надо отформатировать
XLApp.Selection.NumberFormat := '0.00'; // Задаем формат: число с 2-мя знаками после запятой


Цитата
туда хотел дописать Итого и сумму по всем значений в 4 столбце, но вот никак не пойму как сделать в гриде у значения типа стриг, и как их просуммировать
По крайней мере вот это:
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
s: double;
st: string;
begin
s := 0.0;
with StringGrid1 do
begin
for i := 1 to RowCount - FixedRows - 1 do
begin
st := Cells[3, i];
st :=
StringReplace(
StringReplace(st, '.', DecimalSeparator, [rfReplaceAll]),
',', DecimalSeparator, [rfReplaceAll]
);
s := s + StrToFloat(st);
end;
Cells[3, RowCount - FixedRows] := FloatToStr(s);
end;
end;
отработало прекрасно... Все точки и запятые в числах меняются на правильный для твоих установок разделитель...

Цитата
Давно мучает вопрос, как прописать, что бы в поле Edit можно было вводить только 4 цифры и только цифры
Проверяй нажатую кнопку (событие OnKeyPress), и если не цифра, или какой другой нужный символ - то обнуляй:
  if not (Key in ['0' .. '9']) then Key := #0;


Цитата
а так же сделать проверку на его заполнение
А проверить длину Edit1.Text нельзя? Если 0 - то пустой, иначе - заполненный.

Автор: Atreides 11.03.2010 0:50

Не совсем понял с форматированием ячеек

Автор: volvo 11.03.2010 1:06

Что именно не понятно? Тебе какие ячейки отформатировать надо? Вот занеси этот интервал в Range... После выполнения Sheet.Range['нужный_тебе_интервал'].Select эти ячейки "выберутся" (как если бы ты выделил их мышью). А потом уже к выделенным ячейкам применяешь нужное форматирование. Я сделал так, чтобы число представлялось в вещественной форме с двумя символами после запятой. Если ты под "форматированием" имел в виду что-то другое - то объясняй что. Но такое, как я показал тебе делать все равно придется - иначе числа переносятся в Excel неправильно, они все на Sheet-е равняются 64, правильно твоим способом переносятся только строки.

Автор: Atreides 11.03.2010 2:05

под "форматированием" подразумевал ширину ячеек

Автор: volvo 11.03.2010 4:00

А, так тебе надо изменить ширину колонки... Очень похоже на то, что я показывал. Вот так:

        Sheet.Range['D:D'].Select; // Выбираешь какой столбец расширить ...
XLApp.Selection.ColumnWidth := 15; // и увеличиваешь ширину


Вообще, в MSDN иногда заглядывай. Знаешь сколько возможностей там описано для управления Excel-ем? Только с Range вон чего можно творить:
http://msdn.microsoft.com/en-us/library/aa174290%28office.11%29.aspx
(список свойств, методов и объектов внизу страницы посмотри)

Автор: Atreides 17.03.2010 23:20

Вопросец такой, а как мне можно первые две колонки выстроить значения по центру ячейки, а суммы по правому краю?

Автор: volvo 17.03.2010 23:30

Ну вот возьми, сходи по приведенной ссылке, найди там свойство, которое отвечает за выравнивание, и примени это свойство для первого и второго столбца с одним аргументом, а для третьего - с другим. Сколько можно делать все вместо тебя? Ты ж ничего сам делать не желаешь... А мне в общем-то и не очень это надо.

Автор: Atreides 18.03.2010 1:42

нашел такой код:

procedure TForm1.StringGrid1DrawCell(Sender: TObject; Col, Row:

Longint; Rect: TRect; State: TGridDrawState);
var
lRow, lCol: Longint;
begin
lRow := Row;

lCol := Col;
with Sender as TStringGrid, Canvas do
begin
if (gdSelected in State) then
begin
Brush.Color := clHighlight;
end
else if (gdFixed in State) then
begin
Brush.Color := FixedColor;
end
else
begin
Brush.Color := Color;
end;
FillRect(Rect);
SetBkMode(Handle, TRANSPARENT);
SetTextAlign(Handle, TA_RIGHT);
TextOut(Rect.Right - 2, Rect.Top + 2, Cells[lCol, lRow]);
end;
end;

но он посылает меня с Row и Сol. ИМ это я как понимаю, выравнять все по правому краю