unit uRptWordAlbaranCliente; interface uses SysUtils, Classes, AHWord97, IB, IBCustomDataSet, IBDatabase, Word2000, uDAInterfaces, uDADataStreamer, uDABin2DataStreamer, uDAClasses, uDAScriptingProvider, uDADataTable, uDAMemDataTable; type TRptWordAlbaranCliente = class(TDataModule) DABin2DataStreamer: TDABin2DataStreamer; tbl_Cabecera: TDAMemDataTable; tbl_Detalles: TDAMemDataTable; tbl_Empresa: TDAMemDataTable; schReport: TDASchema; DataDictionary: TDADataDictionary; procedure DataModuleCreate(Sender: TObject); private FConnection: IDAConnection; FWordApp : TWordApp; FDocumento : TWordDoc; FPlantilla : string; FCodigoAlbaran : string; FNombreFichero : string; function RellenarInforme : Boolean; procedure RellenarDatosAlbaran; procedure RellenarDatosDetalle; function Generar: Boolean; procedure _GenerarAlbaran(const AID: String); public ImprimirPrecio : Boolean; ImprimirRef : Boolean; function Exportar(Codigo, Fichero : String): Boolean; constructor Create (AOwner : TComponent); override; destructor Destroy; override; end; implementation { TRptWordAlbaranCliente } {$R *.dfm} uses Windows, Variants, Dialogs, uDataModuleServer, uStringsUtils, uSistemaFunc, srvEmpresas_Impl, uROTypes, uROClasses; const rptInforme = 'AlbaranCliente.rdx'; constructor TRptWordAlbaranCliente.Create(AOwner: TComponent); begin inherited; ImprimirPrecio := False; ImprimirRef := False; FDocumento := NIL; end; procedure TRptWordAlbaranCliente.DataModuleCreate(Sender: TObject); begin schReport.ConnectionManager := dmServer.ConnectionManager; FConnection := dmServer.DarNuevaConexion; end; destructor TRptWordAlbaranCliente.Destroy; begin if FDocumento <> NIL then FDocumento.Free; FDocumento := NIL; inherited; end; function TRptWordAlbaranCliente.Generar: Boolean; begin FWordApp := TWordApp.Create (False, False); with FWordApp do begin Visible := False; ScreenUpdating := False; end; FDocumento := TWordDoc.CreateOpenDoc (FWordApp, FPlantilla); FWordApp.SaveActiveDocAs(FNombreFichero); try 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; function TRptWordAlbaranCliente.RellenarInforme: Boolean; begin RellenarDatosAlbaran; RellenarDatosDetalle; Result := True; end; procedure TRptWordAlbaranCliente.RellenarDatosAlbaran; //var // FicheroTemporal : String; // LinkToFile, SaveWithDocument, _Range : OleVariant; // Imagen : InlineShape; 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 if BookmarkExists('CodigoAlbaranCab') then ReplaceBookmark('CodigoAlbaranCab', FieldByName('REFERENCIA').AsString); if BookmarkExists('Referencia_Cliente') then ReplaceBookmark('Referencia_Cliente', FieldByName('REFERENCIA_CLIENTE').AsString); if BookmarkExists('FechaAlbaranCab') then ReplaceBookmark('FechaAlbaranCab', FieldByName('FECHA_ALBARAN').AsString); if BookmarkExists('NombreClienteCab') then ReplaceBookmark('NombreClienteCab', FieldByName('NOMBRE').AsString); if BookmarkExists('DireccionClienteCab') then ReplaceBookmark('DireccionClienteCab', FieldByName('CALLE').AsString); if BookmarkExists('PoblacionClienteCab') then ReplaceBookmark('PoblacionClienteCab', FieldByName('CODIGO_POSTAL').AsString + ' ' + FieldByName('POBLACION').AsString + ' ' + FieldByName('PROVINCIA').AsString); if BookmarkExists('ContactoClienteCab') then ReplaceBookmark('ContactoClienteCab', FieldByName('PERSONA_CONTACTO').AsString); {P571 ReplaceBookmark('BaseImponible', FieldByName('BASEIMPONIBLE').DisplayText); if esCadenaVacia(FieldByName('Descuento').DisplayText) then ReplaceBookmark('Descuento', '0') else ReplaceBookmark('Descuento', FieldByName('DESCUENTO').DisplayText); ReplaceBookmark('ImporteDescuento', FieldByName('IMPORTEDESCUENTO').DisplayText); if esCadenaVacia(FieldByName('IVA').DisplayText) then ReplaceBookmark('IVA', '0') else ReplaceBookmark('IVA', FieldByName('IVA').DisplayText); ReplaceBookmark('ImporteIVA', FieldByName('IMPORTEIVA').DisplayText); ReplaceBookmark('ImporteTotal', FieldByName('IMPORTETOTAL').DisplayText); } if BookmarkExists('NombreEmpresa') then ReplaceBookmark('NombreEmpresa', tbl_Empresa.FieldByName('NOMBRE').AsString); if BookmarkExists('CifEmpresa') then ReplaceBookmark('CifEmpresa', tbl_Empresa.FieldByName('NIF_CIF').AsString); if BookmarkExists('DireccionEmpresa') then ReplaceBookmark('DireccionEmpresa', Format('%s. %s %s', [tbl_Empresa.FieldByName('CALLE').AsString, tbl_Empresa.FieldByName('CODIGO_POSTAL').AsString, tbl_Empresa.FieldByName('POBLACION').AsString])); if BookmarkExists('TelefonoEmpresa') then ReplaceBookmark('TelefonoEmpresa', tbl_Empresa.FieldByName('TELEFONO_1').AsString); if BookmarkExists('FaxEmpresa') then ReplaceBookmark('FaxEmpresa', tbl_Empresa.FieldByName('FAX').AsString); if BookmarkExists('CorreoEmpresa') then ReplaceBookmark('CorreoEmpresa', tbl_Empresa.FieldByName('EMAIL_1').AsString); if BookmarkExists('ImporteTotal') then if ImprimirPrecio then begin ReplaceBookmark('ImporteTotal', FormatFloat(DISPLAY_EUROS2, FieldByName('IMPORTE_TOTAL').AsFloat)); end else begin ReplaceBookmark('ImporteTotal', ''); if BookmarkExists('DescripcionImporteTotal') then ReplaceBookmark('DescripcionImporteTotal', ''); end; end; end; procedure TRptWordAlbaranCliente.RellenarDatosDetalle; var numRows, numCols, mergesplit : OleVariant; MaxCols, iRowCount : Integer; ACantidad: String; AIndice: Integer; AText : String; begin iRowCount := 2; numrows := 2; numcols := 1; mergeSplit := False; MaxCols := 24; with FDocumento.Document.Tables.Item(1), tbl_Detalles do begin First; while not EOF do begin Rows.Item (iRowCount).Cells.Split (numRows, numCols, mergesplit); if ImprimirRef then Cell(iRowCount, 1).Range.Text := FieldByName('REFERENCIA').AsString else Cell(iRowCount, 1).Range.Text := ''; 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 ImprimirPrecio and (FieldByName('IMPORTE_UNIDAD').AsFloat <> 0) then Cell(iRowCount, 4).Range.Text := FormatFloat(DISPLAY_EUROS4_ESPECIAL, FieldByName('IMPORTE_UNIDAD').AsFloat) else Cell(iRowCount, 4).Range.Text := ''; if ImprimirPrecio and (FieldByName('IMPORTE_TOTAL').AsFloat <> 0) then Cell(iRowCount, 5).Range.Text := FormatFloat(DISPLAY_EUROS4_ESPECIAL, FieldByName('IMPORTE_TOTAL').AsFloat) else Cell(iRowCount, 5).Range.Text := ''; Next; Inc (iRowCount); end; Rows.Item(iRowCount).Delete; {while iRowCount <= MaxCols do begin Rows.Item (iRowCount).Cells.Split (numRows, numCols, mergesplit); inc (iRowCount); end;} end; end; function TRptWordAlbaranCliente.Exportar(Codigo, Fichero: String): Boolean; begin if EsCadenaVacia(Fichero) then begin Result := False; raise Exception.Create('Falta indicar el fichero donde se exportará el listado.'); end; FNombreFichero := Fichero; FCodigoAlbaran := Codigo; _GenerarAlbaran(Codigo); Result := True; end; procedure TRptWordAlbaranCliente._GenerarAlbaran(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_ALBARAN').AsString := AID; tbl_Cabecera.Active := True; tbl_Detalles.Active := True; FPlantilla := DarRutaInformes + tbl_Cabecera.FieldByName('ID_EMPRESA').AsString + '\' + rptInforme; FCodigoAlbaran := AID; ACopiaPlantilla := DarFicheroTemporal; CopiarFichero(FPlantilla, ACopiaPlantilla); FPlantilla := ACopiaPlantilla; try if RecuperarEmpresa(tbl_Cabecera.FieldByName('ID_EMPRESA').AsInteger, tbl_Empresa) then Generar; finally SysUtils.DeleteFile(ACopiaPlantilla); end; finally FConnection.RollbackTransaction; //<--- Creo que no va a hacer falta. "PUES SI ES NECESARIO" end; end; end.