|
|
 | Excel celle farve
Fra : Hans Nikolajsen |
Dato : 18-10-08 11:03 |
|
Hej alle!
Jeg bruger Delphi 7.
Jeg har lavet et program der laver et regneark.
Jeg kan ikke finde ud af at få Delphi 7 til at ændre farven på bestemt
celler.
Nogen der har et forslag????
Programmet:
**********************************************************************************************************************
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,DateUtils, StdCtrls, Grids, ComObj;
type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
Edit1: TEdit;
// Indtast årstal.
Edit2: TEdit;
// Indtast initialer.
Button1: TButton;
// Startsknap.
Label1: TLabel;
// Caption årstal.
Label2: TLabel;
// Caption initialer.
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
myDate : TDateTime;
day : array[1..7] of string;
N, R, aar, Taeller, skud, dagensnavn :integer;
X:string;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Edit1.Clear;
Edit2.Clear;
for R := 1 to 8 do
stringgrid1.Cells[0,0]:='Dato';
stringgrid1.Cells[1,0]:='Dag';
stringgrid1.Cells[2,0]:='Komme';
stringgrid1.Cells[3,0]:='Gå';
stringgrid1.Cells[4,0]:='Flex';
stringgrid1.Cells[5,0]:='Flex i alt';
stringgrid1.Cells[6,0]:='Ferie';
end;
function RefToCell(ARow, ACol: Integer): string;
begin
Result := Chr(Ord('A') + ACol - 1) + IntToStr(ARow);
end;
function SaveAsExcelFile(AGrid: TStringGrid; ASheetName, AFileName: string):
Boolean;
const
xlWBATWorksheet = -4167;
var
Row, Col: Integer;
GridPrevFile: string;
XLApp, Sheet, Data: OLEVariant;
i, j: Integer;
begin
// Prepare Data
Data := VarArrayCreate([1, AGrid.RowCount, 1, AGrid.ColCount],
varVariant);
for i := 0 to AGrid.ColCount - 1 do
for j := 0 to AGrid.RowCount - 1 do
Data[j + 1, i + 1] := AGrid.Cells[i, j];
// Create Excel-OLE Object
Result := False;
XLApp := CreateOleObject('Excel.Application');
try
// Hide Excel
XLApp.Visible := False;
// Add new Workbook
XLApp.Workbooks.Add(xlWBatWorkSheet);
Sheet := XLApp.Workbooks[1].WorkSheets[1];
Sheet.Name := ASheetName;
// Fill up the sheet
Sheet.Range[RefToCell(1, 1), RefToCell(AGrid.RowCount,
AGrid.ColCount)].Value := Data;
// Save Excel Worksheet
try
XLApp.Workbooks[1].SaveAs(AFileName);
Result := True;
except
// Error ?
end;
finally
// Quit Excel
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Taeller:=0;
dagensnavn:=0;
aar := strtoint(edit1.Text);
day[1] := 'Mandag';
day[2] := 'Tirsdag';
day[3] := 'Onsdag';
day[4] := 'Torsdag';
day[5] := 'Fredag';
day[6] := 'Lørdag';
day[7] := 'Søndag';
myDate := EncodeDate(aar, 1, 1);
dagensnavn:= DayOfTheWeek(myDate);
skud := 365;
if DateToStr(mydate+59) = '29-02-'+edit1.Text then skud := 366;
for Taeller:= 1 to skud do
begin
X:='=HVIS(D'+inttostr(Taeller+1)+'*24>12,5;HVIS(C'+inttostr(Taeller+1)+'<>0;(D'+inttostr(Taeller+1)+'-C'+inttostr(Taeller+1)+')*24-7,9;-7,4);HVIS(C'+inttostr(Taeller+1)+'<>0;(D'+inttostr(Taeller+1)+'-C'+inttostr(Taeller+1)+')*24-7,4;-7,4))';
//
=HVIS(D2*24>12,5;HVIS(C2<>0;(D2-C2)*24-7,9;-7,4);HVIS(C2<>0;(D2-C2)*24-7,4;-7,4))
if dagensnavn = 6 then X:='';
if dagensnavn = 7 then X:='';
stringgrid1.Cells[0,Taeller]:=DateToStr(mydate+Taeller-1); //dato
stringgrid1.Cells[1,Taeller]:=day[dagensnavn]; //dagnavn
stringgrid1.Cells[4,Taeller]:= X; //Flex formel
stringgrid1.Cells[5,Taeller]:=
'=F'+inttostr(Taeller)+'+E'+inttostr(Taeller+1) ; //Flex I alt
inc(dagensnavn);
if dagensnavn= 8 then dagensnavn:=1;
end;
stringgrid1.Cells[5,1]:= '';
if SaveAsExcelFile(stringGrid1, edit2.Text+' '+inttostr(aar)+' Flex',
'c:\'+edit2.Text+' '+inttostr(aar)+' Flex'+'.xls') then
ShowMessage('Regnearket er gemt som '+ 'c:\'+edit2.Text+'
'+inttostr(aar)+' Flex'+'.xls');
Application.Terminate;
end;
end.
**********************************************************************************************************************
--
--
Mvh
Hans Nikolajsen
| |
 willowcroft@sol.dk (19-10-2008)
| Kommentar
Fra : willowcroft@sol.dk |
Dato : 19-10-08 09:23 |
|
Med TStringGrid skal du farve cellerne ”manuelt” i OnDrawCell.
F.eks. på denne måde:
if (ARow = 2) and (ACol mod 2 = 1) then
begin
with sgStatisticsSystem.Canvas do
begin
Brush.Color := clRed;
FillRect(Rect);
//Font.Color := sgStatisticsSystem.Font.Color;
TextOut(Rect.Left + 4, Rect.Top + 5,
sgStatisticsSystem.Cells[ACol, ARow]);
end;
end;
Med TExtStringGrid delphi.icm.edu.pl/ftp/d50free/EGrid.zip er der
indbygget lettere metoder (men desværre ikke helt uden fejl). Der skal
lige bruges et minut på at få den til at virke i D7.
Hvis nogen kender lettere metoder eller bedre komponenter er jeg meget
interesseret i at få det at vide.
- Esben
On 18 Okt., 12:03, "Hans Nikolajsen" <hansnikolaj...@msn.com> wrote:
> Hej alle!
>
> Jeg bruger Delphi 7.
>
> Jeg har lavet et program der laver et regneark.
> Jeg kan ikke finde ud af at få Delphi 7 til at ændre farven på bestemt
> celler.
> Nogen der har et forslag????
>
> Programmet:
> **********************************************************************************************************************
>
> unit Unit1;
>
> interface
>
> uses
> Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
> Dialogs,DateUtils, StdCtrls, Grids, ComObj;
>
> type
> TForm1 = class(TForm)
> StringGrid1: TStringGrid;
> Edit1: TEdit;
> // Indtast årstal.
> Edit2: TEdit;
> // Indtast initialer.
> Button1: TButton;
> // Startsknap.
> Label1: TLabel;
> // Caption årstal.
> Label2: TLabel;
> // Caption initialer.
>
> procedure FormCreate(Sender: TObject);
> procedure Button1Click(Sender: TObject);
>
> private
> { Private declarations }
> public
> { Public declarations }
> end;
>
> var
> Form1: TForm1;
> myDate : TDateTime;
> day : array[1..7] of string;
> N, R, aar, Taeller, skud, dagensnavn :integer;
> X:string;
>
> implementation
>
> {$R *.dfm}
>
> procedure TForm1.FormCreate(Sender: TObject);
> begin
> Edit1.Clear;
> Edit2.Clear;
> for R := 1 to 8 do
> stringgrid1.Cells[0,0]:='Dato';
> stringgrid1.Cells[1,0]:='Dag';
> stringgrid1.Cells[2,0]:='Komme';
> stringgrid1.Cells[3,0]:='Gå';
> stringgrid1.Cells[4,0]:='Flex';
> stringgrid1.Cells[5,0]:='Flex i alt';
> stringgrid1.Cells[6,0]:='Ferie';
> end;
>
> function RefToCell(ARow, ACol: Integer): string;
> begin
> Result := Chr(Ord('A') + ACol - 1) + IntToStr(ARow);
> end;
>
> function SaveAsExcelFile(AGrid: TStringGrid; ASheetName, AFileName: string):
> Boolean;
> const
> xlWBATWorksheet = -4167;
> var
> Row, Col: Integer;
> GridPrevFile: string;
> XLApp, Sheet, Data: OLEVariant;
> i, j: Integer;
> begin
> // Prepare Data
> Data := VarArrayCreate([1, AGrid.RowCount, 1, AGrid.ColCount],
> varVariant);
> for i := 0 to AGrid.ColCount - 1 do
> for j := 0 to AGrid.RowCount - 1 do
> Data[j + 1, i + 1] := AGrid.Cells[i, j];
> // Create Excel-OLE Object
> Result := False;
> XLApp := CreateOleObject('Excel.Application');
> try
> // Hide Excel
> XLApp.Visible := False;
> // Add new Workbook
> XLApp.Workbooks.Add(xlWBatWorkSheet);
> Sheet := XLApp.Workbooks[1].WorkSheets[1];
> Sheet.Name := ASheetName;
> // Fill up the sheet
> Sheet.Range[RefToCell(1, 1), RefToCell(AGrid.RowCount,
> AGrid.ColCount)].Value := Data;
> // Save Excel Worksheet
> try
> XLApp.Workbooks[1].SaveAs(AFileName);
> Result := True;
> except
> // Error ?
> end;
> finally
> // Quit Excel
> if not VarIsEmpty(XLApp) then
> begin
> XLApp.DisplayAlerts := False;
> XLApp.Quit;
> XLAPP := Unassigned;
> Sheet := Unassigned;
> end;
> end;
> end;
>
> procedure TForm1.Button1Click(Sender: TObject);
> begin
> Taeller:=0;
> dagensnavn:=0;
> aar := strtoint(edit1.Text);
> day[1] := 'Mandag';
> day[2] := 'Tirsdag';
> day[3] := 'Onsdag';
> day[4] := 'Torsdag';
> day[5] := 'Fredag';
> day[6] := 'Lørdag';
> day[7] := 'Søndag';
> myDate := EncodeDate(aar, 1, 1);
> dagensnavn:= DayOfTheWeek(myDate);
> skud := 365;
> if DateToStr(mydate+59) = '29-02-'+edit1.Text then skud := 366;
> for Taeller:= 1 to skud do
> begin
> X:='=HVIS(D'+inttostr(Taeller+1)+'*24>12,5;HVIS(C'+inttostr(Taeller+1)+'<>0;(D'+inttostr(Taeller+1)+'-C'+inttostr(Taeller+1)+')*24-7,9;-7,4);HVIS(C'+inttostr(Taeller+1)+'<>0;(D'+inttostr(Taeller+1)+'-C'+inttostr(Taeller+1)+')*24-7,4;-7,4))';
>
> //
> =HVIS(D2*24>12,5;HVIS(C2<>0;(D2-C2)*24-7,9;-7,4);HVIS(C2<>0;(D2-C2)*24-7,4;-7,4))
>
> if dagensnavn = 6 then X:='';
> if dagensnavn = 7 then X:='';
> stringgrid1.Cells[0,Taeller]:=DateToStr(mydate+Taeller-1); //dato
> stringgrid1.Cells[1,Taeller]:=day[dagensnavn]; //dagnavn
> stringgrid1.Cells[4,Taeller]:= X; //Flex formel
> stringgrid1.Cells[5,Taeller]:=
> '=F'+inttostr(Taeller)+'+E'+inttostr(Taeller+1) ; //Flex I alt
> inc(dagensnavn);
> if dagensnavn= 8 then dagensnavn:=1;
> end;
> stringgrid1.Cells[5,1]:= '';
>
> if SaveAsExcelFile(stringGrid1, edit2.Text+' '+inttostr(aar)+' Flex',
> 'c:\'+edit2.Text+' '+inttostr(aar)+' Flex'+'.xls') then
> ShowMessage('Regnearket er gemt som '+ 'c:\'+edit2.Text+'
> '+inttostr(aar)+' Flex'+'.xls');
> Application.Terminate;
> end;
> end.
>
> **********************************************************************************************************************
>
> --
> --
> Mvh
> Hans Nikolajsen
| |
Henning Madsen (01-12-2008)
| Kommentar
Fra : Henning Madsen |
Dato : 01-12-08 15:28 |
|
<willowcroft@sol.dk> skrev i en meddelelse
news:12cd7612-7fd2-4194-972a-e54ac02f5f39@p59g2000hsd.googlegroups.com...
Med TStringGrid skal du farve cellerne ”manuelt” i OnDrawCell.
F.eks. på denne måde:
if (ARow = 2) and (ACol mod 2 = 1) then
begin
with sgStatisticsSystem.Canvas do
begin
Brush.Color := clRed;
FillRect(Rect);
//Font.Color := sgStatisticsSystem.Font.Color;
TextOut(Rect.Left + 4, Rect.Top + 5,
sgStatisticsSystem.Cells[ACol, ARow]);
end;
end;
Med TExtStringGrid delphi.icm.edu.pl/ftp/d50free/EGrid.zip er der
indbygget lettere metoder (men desværre ikke helt uden fejl). Der skal
lige bruges et minut på at få den til at virke i D7.
Hvis nogen kender lettere metoder eller bedre komponenter er jeg meget
interesseret i at få det at vide.
- Esben
On 18 Okt., 12:03, "Hans Nikolajsen" <hansnikolaj...@msn.com> wrote:
> Hej alle!
>
> Jeg bruger Delphi 7.
>
> Jeg har lavet et program der laver et regneark.
> Jeg kan ikke finde ud af at få Delphi 7 til at ændre farven på bestemt
> celler.
> Nogen der har et forslag????
>
> Programmet:
> **********************************************************************************************************************
>
> unit Unit1;
>
> interface
>
> uses
> Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
> Dialogs,DateUtils, StdCtrls, Grids, ComObj;
>
> type
> TForm1 = class(TForm)
> StringGrid1: TStringGrid;
> Edit1: TEdit;
> // Indtast årstal.
> Edit2: TEdit;
> // Indtast initialer.
> Button1: TButton;
> // Startsknap.
> Label1: TLabel;
> // Caption årstal.
> Label2: TLabel;
> // Caption initialer.
>
> procedure FormCreate(Sender: TObject);
> procedure Button1Click(Sender: TObject);
>
> private
> { Private declarations }
> public
> { Public declarations }
> end;
>
> var
> Form1: TForm1;
> myDate : TDateTime;
> day : array[1..7] of string;
> N, R, aar, Taeller, skud, dagensnavn :integer;
> X:string;
>
> implementation
>
> {$R *.dfm}
>
> procedure TForm1.FormCreate(Sender: TObject);
> begin
> Edit1.Clear;
> Edit2.Clear;
> for R := 1 to 8 do
> stringgrid1.Cells[0,0]:='Dato';
> stringgrid1.Cells[1,0]:='Dag';
> stringgrid1.Cells[2,0]:='Komme';
> stringgrid1.Cells[3,0]:='Gå';
> stringgrid1.Cells[4,0]:='Flex';
> stringgrid1.Cells[5,0]:='Flex i alt';
> stringgrid1.Cells[6,0]:='Ferie';
> end;
>
> function RefToCell(ARow, ACol: Integer): string;
> begin
> Result := Chr(Ord('A') + ACol - 1) + IntToStr(ARow);
> end;
>
> function SaveAsExcelFile(AGrid: TStringGrid; ASheetName, AFileName:
> string):
> Boolean;
> const
> xlWBATWorksheet = -4167;
> var
> Row, Col: Integer;
> GridPrevFile: string;
> XLApp, Sheet, Data: OLEVariant;
> i, j: Integer;
> begin
> // Prepare Data
> Data := VarArrayCreate([1, AGrid.RowCount, 1, AGrid.ColCount],
> varVariant);
> for i := 0 to AGrid.ColCount - 1 do
> for j := 0 to AGrid.RowCount - 1 do
> Data[j + 1, i + 1] := AGrid.Cells[i, j];
> // Create Excel-OLE Object
> Result := False;
> XLApp := CreateOleObject('Excel.Application');
> try
> // Hide Excel
> XLApp.Visible := False;
> // Add new Workbook
> XLApp.Workbooks.Add(xlWBatWorkSheet);
> Sheet := XLApp.Workbooks[1].WorkSheets[1];
> Sheet.Name := ASheetName;
> // Fill up the sheet
> Sheet.Range[RefToCell(1, 1), RefToCell(AGrid.RowCount,
> AGrid.ColCount)].Value := Data;
> // Save Excel Worksheet
> try
> XLApp.Workbooks[1].SaveAs(AFileName);
> Result := True;
> except
> // Error ?
> end;
> finally
> // Quit Excel
> if not VarIsEmpty(XLApp) then
> begin
> XLApp.DisplayAlerts := False;
> XLApp.Quit;
> XLAPP := Unassigned;
> Sheet := Unassigned;
> end;
> end;
> end;
>
> procedure TForm1.Button1Click(Sender: TObject);
> begin
> Taeller:=0;
> dagensnavn:=0;
> aar := strtoint(edit1.Text);
> day[1] := 'Mandag';
> day[2] := 'Tirsdag';
> day[3] := 'Onsdag';
> day[4] := 'Torsdag';
> day[5] := 'Fredag';
> day[6] := 'Lørdag';
> day[7] := 'Søndag';
> myDate := EncodeDate(aar, 1, 1);
> dagensnavn:= DayOfTheWeek(myDate);
> skud := 365;
> if DateToStr(mydate+59) = '29-02-'+edit1.Text then skud := 366;
> for Taeller:= 1 to skud do
> begin
> X:='=HVIS(D'+inttostr(Taeller+1)+'*24>12,5;HVIS(C'+inttostr(Taeller+1)+'<>0;(D'+inttostr(Taeller+1)+'-C'+inttostr(Taeller+1)+')*24-7,9;-7,4);HVIS(C'+inttostr(Taeller+1)+'<>0;(D'+inttostr(Taeller+1)+'-C'+inttostr(Taeller+1)+')*24-7,4;-7,4))';
>
> //
> =HVIS(D2*24>12,5;HVIS(C2<>0;(D2-C2)*24-7,9;-7,4);HVIS(C2<>0;(D2-C2)*24-7,4;-7,4))
>
> if dagensnavn = 6 then X:='';
> if dagensnavn = 7 then X:='';
> stringgrid1.Cells[0,Taeller]:=DateToStr(mydate+Taeller-1); //dato
> stringgrid1.Cells[1,Taeller]:=day[dagensnavn]; //dagnavn
> stringgrid1.Cells[4,Taeller]:= X; //Flex formel
> stringgrid1.Cells[5,Taeller]:=
> '=F'+inttostr(Taeller)+'+E'+inttostr(Taeller+1) ; //Flex I alt
> inc(dagensnavn);
> if dagensnavn= 8 then dagensnavn:=1;
> end;
> stringgrid1.Cells[5,1]:= '';
>
> if SaveAsExcelFile(stringGrid1, edit2.Text+' '+inttostr(aar)+' Flex',
> 'c:\'+edit2.Text+' '+inttostr(aar)+' Flex'+'.xls') then
> ShowMessage('Regnearket er gemt som '+ 'c:\'+edit2.Text+'
> '+inttostr(aar)+' Flex'+'.xls');
> Application.Terminate;
> end;
> end.
>
> **********************************************************************************************************************
>
> --
> --
> Mvh
> Hans Nikolajsen
Hvis du kan bruge følge program løsning kan du få programeringen bagefter.
På formen er anbragt en XStringGrid, som jeg varmt kan anbefal men tror ikke
det her er forskel på den og StringGrid.
Når man klikker på den aktuelle Celle Kopieres cellens indhol til Edit3 nu
kan man i Edit3 skrive eller rette derefter klikker man på Radio Button 1
eller to for at vælge farve, her Sort eller Rød skrift derefter tryk på
Button 1 og vupsi den skrevne eller rettede skrift føres tilbage til den
celle der var aktuel med skriftfarven Sort eller Rød.
NB Jeg bruger også Delphi 7
Er det noget du kan bruge får du programmet bagefter.
MVH Henning
| |
|
|