Gracias por contestar, lo envio de la sgte manera
Código Delphi
[-]
procedure TFrmSemaforo.CopyExcel(grid:TwwDbGrid);
var
WorkBk : _WorkBook; WorkSheet : _WorkSheet; I, J, K, R, C : Integer;
nVen : Integer;
IIndex : OleVariant;
TabGrid : Variant;
begin
IIndex := 1;
R := Grid.DataSource.DataSet.RecordCount+5;
C := Grid.GetColCount-1;
TabGrid := VarArrayCreate([0,(R +10),0,(C - 1)],varVariant);
I := 0;
k := 0;
grid.DataSource.DataSet.First;
repeat
for J := 0 to (C - 1) do
if (I = 0) then begin
TabGrid[I+4,J] := grid.Fields[K].DisplayName; inc(K);
end else
if grid.Fields[j].IsNull then
TabGrid[I+4,J] := ' ' else
TabGrid[I+4,J] := grid.Fields[j].AsVariant; if (I > 0) then grid.DataSource.DataSet.Next;
Inc(I);
until (I) > (R-5);
XLApp := TExcelApplication.Create(nil);
XLApp.ConnectKind := (ckNewInstance);
XLApp.Connect; XLApp.WorkBooks.Add(OleVariant(xlWBATWorksheet),IIndex); WorkBk := XLApp.WorkBooks.Item[IIndex]; WorkSheet := WorkBk.WorkSheets.Get_Item(1) as _WorkSheet; Worksheet.Range['A1',Worksheet.Cells.Item[R,C]].Value := TabGrid; WorkSheet.Cells.item[1,1].Font.Bold := true;
WorkSheet.Cells.item[1,1].Font.Size := 12;
WorkSheet.Cells.item[1,1].Font.Underline := 2;
WorkSheet.Cells.item[1,1].Value := 'Semaforo de Mantenimientos';
WorkSheet.Cells.item[2,1].Font.Bold := true;
WorkSheet.Cells.item[2,1].Font.Size := 12;
WorkSheet.Cells.item[2,1].Font.Underline := 2;
WorkSheet.Cells.item[2,1].Value := FormatDateTime('mmmm/dd/yyyy hh:mm AM/PM',Now);
WorkSheet.Cells.item[3,1].Font.Bold := true;
WorkSheet.Cells.item[3,1].Font.Size := 12;
WorkSheet.Cells.item[3,1].Font.Underline := 2;
WorkSheet.Cells.item[3,1].Value := 'Division ' + eDivIni.Text;
if rbtr3.checked = False Then Begin I := 5; repeat for J := 1 to (C ) do Begin
Worksheet.Cells.Item[I,J].Borders.LineStyle := xlContinuous; if (I = 5) then Begin
worksheet.Cells.item[I,J].Font.Bold := True;
if J >= 2 then
if rbtr2.checked = True then Worksheet.Cells.Item[I,J].Orientation := 90; end
else Begin
if J >= 2 then
if j < c then Begin
nVen := worksheet.Cells.item[I,J].value ;
if nVen = 0 then worksheet.Cells.item[I,J].Value := ' ';
if nVen >= strtoint(ev1.text) then
begin
if nVen <= strtoint(ev2.text) then
end;
if nVen >= strtoint(ev3.text) then
begin
if nVen <= strtoint(ev4.text) then
worksheet.Cells.Item[I,J].Interior.ColorIndex := 6; end;
if nVen > strtoint(ev5.text) then Begin
worksheet.Cells.item[I,J].Font.Bold := True;
worksheet.Cells.item[I,J].Font.Color := clWhite;
worksheet.Cells.Item[I,J].Interior.ColorIndex := 3; end;
end; end; end; Inc(I);
until I > (R); Worksheet.Range['A1',Worksheet.Cells.Item[R,C]].Columns.Autofit; workSheet.Cells.item[R+2,3].Value := 'Simbologia';
if rbv4.checked = True then Begin
worksheet.Cells.Item[R+3,2].Interior.ColorIndex := 3; workSheet.Cells.item[R+3,3].Value := 'Mantenimientos arriba del '+ ev5.text+' % de Vencimiento';
worksheet.Cells.Item[R+4,2].Interior.ColorIndex := 6; workSheet.Cells.item[R+4,3].Value := 'Mantenimientos entre el '+ev3.text + ' % y el '+ ev4.text+ ' % de Vencimiento';
workSheet.Cells.item[R+5,3].Value := 'Mantenimientos entre el '+ev1.text + ' % y el '+ ev2.text+ ' % de Vencimiento';
end;
if rbv3.checked = True then Begin
worksheet.Cells.Item[R+3,2].Interior.ColorIndex := 3; workSheet.Cells.item[R+3,3].Value := 'Mantenimientos arriba del '+ ev5.text+' % de Vencimiento';
end;
if rbv2.checked = True then Begin
worksheet.Cells.Item[R+3,2].Interior.ColorIndex := 6; workSheet.Cells.item[R+3,3].Value := 'Mantenimientos entre el '+ev3.text + ' % y el '+ ev4.text+ ' % de Vencimiento';
end;
if rbv1.checked = True then Begin
workSheet.Cells.item[R+3,3].Value := 'Mantenimientos entre el '+ev1.text + ' % y el '+ ev2.text+ ' % de Vencimiento';
end;
end
else Worksheet.Range['A1',Worksheet.Cells.Item[R,C]].Columns.Autofit; if c > 22 then begin worksheet.PageSetup.Orientation := 2;
end;
if Tipo_R = 'E' then XLApp.Visible[0] := True; if Tipo_R = 'P' then begin
worksheet.PrintOut(null,null,1,null,null,null,null,0);
end;
XLApp.Disconnect; inc(IIndex);
TabGrid := Unassigned; end;