unit uRptWordFacturaCliente; interface uses SysUtils, Classes, AHWord97, IB, IBCustomDataSet, IBDatabase, Word2000, uDAInterfaces, uDADataStreamer, uDABin2DataStreamer, uDAClasses, uDAScriptingProvider, uDADataTable, uDAMemDataTable; type TRptWordFacturaCliente = class(TDataModule) DABin2DataStreamer: TDABin2DataStreamer; tbl_Cabecera: TDAMemDataTable; tbl_Detalles: TDAMemDataTable; tbl_Empresa: TDAMemDataTable; tbl_Vencimientos: TDAMemDataTable; schReport: TDASchema; DataDictionary: TDADataDictionary; procedure DataModuleCreate(Sender: TObject); private FConnection: IDAConnection; FPlantilla : string; FWordApp : TWordApp; FDocumento : TWordDoc; // FNumCapitulos : Integer; FCodigoFactura : string; FNombreFichero : String; FVerSello : Boolean; // function DarNumCapitulos : Integer; // procedure InsertarConceptos(Tabla : Table); function Generar : Boolean; function RellenarCabecera : boolean; virtual; function RellenarInforme : boolean; virtual; procedure _GenerarFactura(const AID: String); public function Exportar(Codigo, Fichero : String; const VerSello: Boolean = True): Boolean; constructor Create (AOwner : TComponent); override; destructor Destroy; override; end; implementation { TRptWordFacturaCliente } {$R *.dfm} uses Windows, Variants, Dialogs, uDataModuleServer, uStringsUtils, uSistemaFunc, srvEmpresas_Impl, uROTypes, uROClasses; const rptInforme = 'FacturaCliente.rdx'; constructor TRptWordFacturaCliente.Create(AOwner: TComponent); begin inherited; FDocumento := NIL; end; {function TRptWordFacturaCliente.DarNumCapitulos: Integer; var AuxNumCapitulos : integer; begin AuxNumCapitulos := 0; tbl_Cabecera.First; while not tbl_Cabecera.Eof do begin if tbl_Cabecera.FieldByName('TIPO_DETALLE').AsString = 'Titulo' then AuxNumCapitulos := AuxNumCapitulos + 1; tbl_Cabecera.Next; end; tbl_Cabecera.First; Result := AuxNumCapitulos; end;} destructor TRptWordFacturaCliente.Destroy; begin if FDocumento <> NIL then FDocumento.Free; FDocumento := NIL; inherited; end; function TRptWordFacturaCliente.Exportar(Codigo, Fichero: String; const VerSello: Boolean = True): Boolean; begin if EsCadenaVacia(Fichero) then begin Result := False; raise Exception.Create('Falta indicar el fichero donde se exportará el listado.'); end; FNombreFichero := Fichero; FCodigoFactura := Codigo; FVerSello := VerSello; _GenerarFactura(Codigo); Result := True; end; procedure TRptWordFacturaCliente.DataModuleCreate(Sender: TObject); begin schReport.ConnectionManager := dmServer.ConnectionManager; FConnection := dmServer.DarNuevaConexion; end; function TRptWordFacturaCliente.Generar : Boolean; begin FWordApp := TWordApp.Create (False, False); with FWordApp do begin Visible := False; ScreenUpdating := False; end; FDocumento := TWordDoc.CreateNewDoc(FWordApp, FPlantilla); FWordApp.SaveActiveDocAs(FNombreFichero); try if not RellenarCabecera then RaiseError('Se producido un error al generar la cabecera en MS Word.'); if not RellenarInforme then RaiseError('Se producido un error al generar el informe en MS Word.'); FWordApp.CloseApp(wdSaveChanges); Result := True; finally FDocumento := NIL; FWordApp := NIL; end; end; {procedure TRptWordFacturaCliente.InsertarConceptos(Tabla : Table); var numRows, numCols, mergeSplit, shiftCells : OleVariant; iContador : Integer; TotalConceptos : Double; ACantidad: String; AIndice: Integer; AText : String; begin TotalConceptos := 0; numRows := 2; numCols := 1; mergeSplit := False; shiftCells := False; iContador := 2; // Empezar en la 2ª fila de celdas. La primera es la // cabecera de la tabla. with Tabla, tbl_Detalles do begin while not EOF do begin if FieldByName('TIPO_DETALLE').AsString <> 'Concepto' then Break; // Partir la celda actual en 2 filas de 1 columna. Rows.Item(iContador).Cells.Split (numRows, numCols, mergesplit); Cell(iContador, 1).Range.Text := FieldByName('CONCEPTO').AsString; ACantidad := FloatToStr(FieldByName('CANTIDAD').AsFloat); AIndice := Pos(',', ACantidad); if AIndice > 0 then AText := FormatFloat('#,0.00', FieldByName('CANTIDAD').AsFloat) else AText := FormatFloat('#,0.##', FieldByName('CANTIDAD').AsFloat); Cell(iContador, 2).Range.Text := AText; if (FieldByName('IMPORTE_UNIDAD').AsFloat = 0) then Cell(iContador, 3).Range.Text := '' else Cell(iContador, 3).Range.Text := FormatFloat(DISPLAY_EUROS2, FieldByName('IMPORTE_UNIDAD').AsFloat); if (FieldByName('IMPORTE_TOTAL').AsFloat = 0) then Cell(iContador, 4).Range.Text := '' else Cell(iContador, 4).Range.Text := FormatFloat(DISPLAY_EUROS2, FieldByName('IMPORTE_TOTAL').AsFloat); TotalConceptos := TotalConceptos + FieldByName('IMPORTE_TOTAL').AsFloat; Next; Inc (iContador); end; // Borrar la fila vacía que sobra Rows.Item(iContador).Cells.Delete(shiftCells); Cell(iContador, 1).Range.Text := 'Total: ' + FormatFloat(DISPLAY_EUROS2, TotalConceptos); AutoFitBehavior(wdAutoFitWindow); end; end;} function TRptWordFacturaCliente.RellenarCabecera: boolean; var NombreFichero, Texto, // FicheroTemporal : String; // LinkToFile, SaveWithDocument, _Range : OleVariant; // Imagen : InlineShape; _ShiftCells : OleVariant; ImporteAux : Double; Cadena : String; begin //PARA DIBUJAR EL LOGOTIPO MULTIEMPRESA {--------------------------- PENDIENTE if (EmpresaActiva.Logotipo <> Nil) then begin //Activamos cabecera FWordApp.Application.ActiveWindow.ActivePane.View.SeekView := wdSeekCurrentPageHeader; LinkToFile := False; SaveWithDocument := True; _Range := EmptyParam; FicheroTemporal := DarFicheroTemporal; EmpresaActiva.Logotipo.SaveToFile (FicheroTemporal); Imagen := FWordApp.Application.ActiveWindow.ActivePane.Selection.InlineShapes.AddPicture(ficherotemporal, LinkToFile, SaveWithDocument, _Range); //Formateamos imagen if ((Imagen.Get_Width > ANCHO_LOGO_INF)) then begin Imagen.Set_Height(((ANCHO_LOGO_INF * Imagen.Get_Height) /Imagen.Get_Width)); Imagen.Set_Width(ANCHO_LOGO_INF); end; end; ---------------------------- } with FDocumento, tbl_Cabecera do begin //Activamos cabecera FWordApp.Application.ActiveWindow.ActivePane.View.SeekView := wdSeekCurrentPageHeader; if (FieldByName('TIPO').AsString = 'F') then ReplaceBookmark('CodigoFacturaCab', FieldByName('REFERENCIA').AsString) else ReplaceBookmark('CodigoFacturaCab', FieldByName('REFERENCIA').AsString); ReplaceBookmark('FechaFacturaCab', FieldByName('FECHA_FACTURA').AsString); //Se cambia se omiten los vencimientos de los recibos solo tendremos en cuenta el de la factura Cadena := FieldByName('FECHA_VENCIMIENTO').AsString; { tbl_Vencimientos.First; Cadena := ''; while not tbl_Vencimientos.eof do begin Cadena := Cadena + tbl_Vencimientos.FieldByName('FECHA_VENCIMIENTO').AsString + ' '; tbl_Vencimientos.Next; end; } ReplaceBookmark('VencimientoCab', Cadena); ReplaceBookmark('FormaPagoCab', FieldByName('FORMA_PAGO').AsString); ReplaceBookmark('BancoCab', FieldByName('DATOS_BANCARIOS').AsString); ReplaceBookmark('NombreClienteCab', FieldByName('NOMBRE').AsString); ReplaceBookmark('CIFClienteCab', FieldByName('NIF_CIF').AsString); ReplaceBookmark('DireccionClienteCab', FieldByName('CALLE').AsString); ReplaceBookmark('PoblacionClienteCab', FieldByName('CODIGO_POSTAL').AsString + ' ' + FieldByName('POBLACION').AsString + ' ' + FieldByName('PROVINCIA').AsString); ReplaceBookmark('BaseImponible', FormatFloat(DISPLAY_EUROS2, FieldByName('IMPORTE_NETO').AsFloat)); ImporteAux := FieldByName('BASE_IMPONIBLE').AsFloat; // - FieldByName('IMPORTE_DESCUENTO').AsFloat; ReplaceBookmark('BaseImponible2', FormatFloat(DISPLAY_EUROS2, ImporteAux)); if (FieldByName('DESCUENTO').AsInteger = 0) then begin ReplaceBookmark('BaseImponibleTexto', 'Base imponible'); FWordApp.GotoBookmark('CeldasDescuento'); _ShiftCells := wdDeleteCellsShiftLeft; FWordApp.Application.Selection.Cells.Delete(_ShiftCells); end else begin ReplaceBookmark('Descuento', FieldByName('DESCUENTO').AsString); ReplaceBookmark('ImporteDto', FormatFloat(DISPLAY_EUROS2, FieldByName('IMPORTE_DESCUENTO').AsFloat)); end; if EsCadenaVacia(FieldByName('IVA').AsString) then ReplaceBookmark('IVA', '0') else ReplaceBookmark('IVA', FieldByName('IVA').AsString); ReplaceBookmark('ImporteIVA', FormatFloat(DISPLAY_EUROS2, FieldByName('IMPORTE_IVA').AsFloat)); ReplaceBookmark('ImporteTotal', FormatFloat(DISPLAY_EUROS2, FieldByName('IMPORTE_TOTAL').AsFloat)); if (FieldByName('RETENCION').AsInteger = 0) then begin FWordApp.GotoBookmark('CeldasRetencion'); _ShiftCells := wdDeleteCellsShiftLeft; FWordApp.Application.Selection.Cells.Delete(_ShiftCells); end else begin ReplaceBookmark('TituloImporteTotal', 'Total certificacion'); ReplaceBookmark('Retencion', FieldByName('RETENCION').AsString); ReplaceBookmark('ImporteRetencion', FormatFloat(DISPLAY_EUROS2, FieldByName('IMPORTE_RETENCION').AsFloat)); ReplaceBookmark('ImporteTotalRet', FormatFloat(DISPLAY_EUROS2, (FieldByName('IMPORTE_TOTAL').AsFloat - FieldByName('IMPORTE_RETENCION').AsFloat))); end; Texto := FieldByName('OBSERVACIONES').AsString; if not EsCadenaVacia(Texto) then begin NombreFichero := DarFicheroTemporal; EscribirEnFichero(NombreFichero, Texto); FWordApp.InsertFile(NombreFichero, 'Descripcion'); SysUtils.DeleteFile(NombreFichero); end; if (tbl_Cabecera.FieldByName('ID_EMPRESA').AsInteger <> 3) then begin ReplaceBookmark('NombreEmpresa', tbl_Empresa.FieldByName('NOMBRE').AsString); ReplaceBookmark('CifEmpresa', tbl_Empresa.FieldByName('NIF_CIF').AsString); ReplaceBookmark('DireccionEmpresa', Format('%s. %s %s', [tbl_Empresa.FieldByName('CALLE').AsString, tbl_Empresa.FieldByName('CODIGO_POSTAL').AsString, tbl_Empresa.FieldByName('POBLACION').AsString])); ReplaceBookmark('TelefonoEmpresa', tbl_Empresa.FieldByName('TELEFONO_1').AsString); ReplaceBookmark('FaxEmpresa', tbl_Empresa.FieldByName('FAX').AsString); ReplaceBookmark('CorreoEmpresa', tbl_Empresa.FieldByName('EMAIL_1').AsString); ReplaceBookmark('DatosRegistroMercantil', tbl_Empresa.FieldByName('REGISTRO_MERCANTIL').AsString); end; if not FVerSello then ReplaceBookmark('Sello', ''); if (tbl_Cabecera.FieldByName('CERTIFICADO_ISO').AsInteger <> 1) then begin ReplaceBookmark('ISO', ''); end; Close; end; Result := True; end; function TRptWordFacturaCliente.RellenarInforme : boolean; var numRows, numCols, mergesplit : OleVariant; iRowCount : Integer; TipoConAnterior : String; Seleccion : TWordRange; TotalCapitulo : Double; EsCapitulo : Boolean; ACantidad: String; AIndice: Integer; AText : String; begin Result := False; iRowCount := 2; numrows := 2; numcols := 1; mergeSplit := False; TipoConAnterior := ''; TotalCapitulo := 0; EsCapitulo := False; with FDocumento.Document.Tables.Item(1), tbl_detalles do begin First; while not tbl_detalles.EOF do begin if (TipoConAnterior = 'Concepto') and (FieldByName('TIPO_DETALLE').AsString = 'Titulo') then begin Rows.Item (iRowCount).Cells.Split (numRows, numCols, mergesplit); if EsCapitulo then begin Rows.Item (iRowCount).Cells.Split (numRows, numCols, mergesplit); Cell(iRowCount, 2).Range.Text := 'TOTAL DEL CAPÍTULO'; Cell(iRowCount, 5).Range.Text := FormatFloat(DISPLAY_EUROS2, TotalCapitulo); TotalCapitulo := 0; Inc (iRowCount); end; Inc (iRowCount); end; Rows.Item (iRowCount).Cells.Split (numRows, numCols, mergesplit); if FieldByName('TIPO_DETALLE').AsString = 'Titulo' then begin Cell(iRowCount, 2).Range.Text := FieldByName('CONCEPTO').AsString; Rows.Item(iRowCount).Select; Seleccion := FDocumento.AddRangeFromSelection; Seleccion.Bold := True; TotalCapitulo := 0; EsCapitulo := True; end else begin Cell(iRowCount, 1).Range.Text := FieldByName('REFERENCIA').AsString; Cell(iRowCount, 2).Range.Text := FieldByName('CONCEPTO').AsString; ACantidad := FloatToStr(FieldByName('CANTIDAD').AsFloat); if ACantidad = '0' then AText := '' else begin AIndice := Pos(',', ACantidad); if AIndice > 0 then AText := FormatFloat('#,0.00', FieldByName('CANTIDAD').AsFloat) else AText := FormatFloat('#,0.##', FieldByName('CANTIDAD').AsFloat); end; Cell(iRowCount, 3).Range.Text := AText + ' ' + FieldByName('UNIDAD_MEDIDA').AsString; if FieldByName('IMPORTE_UNIDAD').AsFloat <> 0 then Cell(iRowCount, 4).Range.Text := FormatFloat(DISPLAY_EUROS4, FieldByName('IMPORTE_UNIDAD').AsFloat); if FieldByName('IMPORTE_TOTAL').AsFloat <> 0 then Cell(iRowCount, 5).Range.Text := FormatFloat(DISPLAY_EUROS4, FieldByName('IMPORTE_TOTAL').AsFloat); TotalCapitulo := TotalCapitulo + FieldByName('IMPORTE_TOTAL').AsFloat; end; TipoConAnterior := FieldByName('TIPO_DETALLE').AsString; Next; Inc (iRowCount); end; if EsCapitulo then begin Rows.Item (iRowCount).Cells.Split (numRows, numCols, mergesplit); Cell(iRowCount, 2).Range.Text := 'TOTAL DEL CAPÍTULO'; Cell(iRowCount, 5).Range.Text := FormatFloat(DISPLAY_EUROS2, TotalCapitulo); TotalCapitulo := 0; end; Close; end; Result := True; end; procedure TRptWordFacturaCliente._GenerarFactura(const AID: String); var ACopiaPlantilla : String; begin FConnection.BeginTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" try tbl_Cabecera.ParamByName('ID').AsString := AID; tbl_Detalles.ParamByName('ID_FACTURA').AsString := AID; tbl_Vencimientos.ParamByName('ID_FACTURA').AsString := AID; tbl_Cabecera.Active := True; tbl_Detalles.Active := True; tbl_Vencimientos.Active := True; FPlantilla := DarRutaInformes + tbl_Cabecera.FieldByName('ID_EMPRESA').AsString + '\' + rptInforme; FCodigoFactura := AID; if RecuperarEmpresa(tbl_Cabecera.FieldByName('ID_EMPRESA').AsInteger, tbl_Empresa) then begin ACopiaPlantilla := DarFicheroTemporal; CopiarFichero(FPlantilla, ACopiaPlantilla); FPlantilla := ACopiaPlantilla; try Generar; finally SysUtils.DeleteFile(ACopiaPlantilla); end; end; finally FConnection.RollbackTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" end; end; end.