&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12 &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure /*------------------------------------------------------------------------ File : Purpose : Syntax : Description : Author(s) : Created : Notes : ----------------------------------------------------------------------*/ /* This .W file was created with the Progress AppBuilder. */ /*----------------------------------------------------------------------*/ /* *************************** Definitions ************************** */ DEFINE INPUT PARAMETER iphParam AS HANDLE NO-UNDO. DEFINE OUTPUT PARAMETER opcResult AS CHARACTER NO-UNDO. DEFINE VARIABLE iSeite AS INTEGER NO-UNDO. DEFINE VARIABLE iAnzDok AS INTEGER NO-UNDO. DEFINE VARIABLE iLauf AS INTEGER NO-UNDO. DEFINE VARIABLE lFirst AS LOG INIT FALSE NO-UNDO. DEFINE VARIABLE lLast AS LOG INIT FALSE NO-UNDO. DEFINE VARIABLE lPreis AS LOG NO-UNDO. DEFINE VARIABLE cFirma AS CHARACTER NO-UNDO. DEFINE VARIABLE AdFirma AS CHARACTER NO-UNDO. DEFINE VARIABLE nFakBetr AS DECIMAL NO-UNDO. DEFINE VARIABLE dFakDatum AS DATE NO-UNDO. DEFINE VARIABLE iFaknr AS INTEGER NO-UNDO. DEFINE VARIABLE iSprcd AS INTEGER NO-UNDO. DEFINE VARIABLE nTotale AS DECIMAL EXTENT 15 NO-UNDO. DEFINE VARIABLE cFormtext AS CHARACTER EXTENT 30 NO-UNDO. DEFINE VARIABLE cRabText AS CHARACTER NO-UNDO. DEFINE VARIABLE cZusText AS CHARACTER NO-UNDO. DEFINE VARIABLE cEpzText AS CHARACTER NO-UNDO. DEFINE VARIABLE cBesrKopf AS CHARACTER EXTENT 12 NO-UNDO. DEFINE VARIABLE lDebIncl AS LOG NO-UNDO. DEFINE VARIABLE Rundbetr AS DECIMAL DECIMALS 4 NO-UNDO. DEFINE VARIABLE RundCode AS INTEGER INIT 1 NO-UNDO. DEFINE VARIABLE htTabTexte AS HANDLE NO-UNDO. DEFINE VARIABLE hAufko AS HANDLE NO-UNDO. DEFINE VARIABLE cExcelDocument AS CHARACTER NO-UNDO. DEFINE VARIABLE cVPRDocument AS CHARACTER NO-UNDO. DEFINE VARIABLE cPDFDocument AS CHARACTER NO-UNDO. DEFINE VARIABLE cInstallation AS CHARACTER NO-UNDO. DEFINE VARIABLE cFileName AS CHARACTER NO-UNDO. DEFINE VARIABLE iBesrArt AS INTEGER NO-UNDO. DEFINE VARIABLE lJa AS LOGICAL NO-UNDO. DEFINE BUFFER bAufko FOR Aufko . DEFINE BUFFER bAufze FOR Aufze . DEFINE BUFFER FDebst FOR Debst . /* Fakturaadresse */ DEFINE BUFFER LDebst FOR Debst . /* Lieferadresse */ DEFINE BUFFER LAdresse FOR Adresse . DEFINE BUFFER bAdresse FOR Adresse . DEFINE BUFFER bWust FOR Wust . DEFINE BUFFER bSteuer FOR Steuer . DEFINE VARIABLE hExcel AS COMPONENT-HANDLE NO-UNDO. DEFINE VARIABLE cZelle AS CHARACTER NO-UNDO. DEFINE VARIABLE iZeile AS INTEGER NO-UNDO. { incl/properties.i } { incl/ttdruckparam.i } { swissqr/propertiesSwissQR.i } DEFINE TEMP-TABLE tTotale FIELD nMwstPfl AS DECIMAL EXTENT 12 FIELD nMwstBet AS DECIMAL EXTENT 12 FIELD nSammTot AS DECIMAL FIELD nSkBer AS DECIMAL FIELD nWW AS DECIMAL . DEFINE TEMP-TABLE sAufko FIELD cFirma AS CHARACTER FIELD iAufnr AS INTEGER FIELD iFak_Knr AS INTEGER FIELD iSamm_Nr AS INTEGER FIELD iRecid AS RECID FIELD iFaknr AS INTEGER FIELD dFakDat AS DATE . DEFINE TEMP-TABLE tAufko LIKE Aufko FIELD iRecid AS RECID FIELD lBetrag AS LOGICAL . DEFINE TEMP-TABLE tAufze FIELD Aufnr AS INTEGER FIELD Sort1 AS CHARACTER FIELD Sort2 AS CHARACTER FIELD Sort3 AS CHARACTER FIELD Artnr AS INTEGER FIELD Inhalt AS INTEGER FIELD Jahr AS INTEGER FIELD Pos AS INTEGER FIELD Zeile AS RECID FIELD Preis AS DECIMAL DECIMALS 4 FIELD Aktion AS LOG FIELD LagOrt AS CHARACTER FIELD MGeli AS DECIMAL FIELD MRuek AS DECIMAL INDEX tAufze-k1 IS PRIMARY Aufnr Sort1 Sort2 Sort3 . DEFINE TEMP-TABLE tSpeRab FIELD Rab_Grp AS INTEGER FIELD Auf_Betr AS DECIMAL DECIMALS 4 . DEFINE TEMP-TABLE tGebKto FIELD Sort_Cd AS CHARACTER FIELD Geb_Cd AS CHARACTER FIELD Bez AS CHARACTER FIELD Preis AS DECIMAL FIELD A_Anz AS DECIMAL FIELD A_Betrag AS DECIMAL FIELD E_Anz AS DECIMAL FIELD E_Betrag AS DECIMAL FIELD MWST_Art AS INTEGER FIELD MWST_Cd AS INTEGER . DEFINE TEMP-TABLE tRabSumm FIELD Rab_Summ AS INTEGER FIELD Bez AS CHARACTER FIELD F_Rab_Art AS INTEGER FIELD F_Wert AS DECIMAL DECIMALS 4 FIELD A_Rab_Art AS INTEGER FIELD A_Wert AS DECIMAL DECIMALS 4 FIELD Auf_Rab AS DECIMAL DECIMALS 4 FIELD Abh_Rab AS DECIMAL DECIMALS 4 . DEFINE TEMP-TABLE tTabTexte FIELD cRecArt AS CHARACTER FIELD iZeile AS INTEGER FIELD cFeld1 AS CHARACTER FIELD cFeld2 AS CHARACTER FIELD cFeld3 AS CHARACTER FIELD iFeld1 AS INTEGER FIELD iFeld2 AS INTEGER FIELD iFeld3 AS INTEGER INDEX tTabTexte-k1 IS PRIMARY cRecArt iZeile. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK /* ******************** Preprocessor Definitions ******************** */ &Scoped-define PROCEDURE-TYPE Procedure &Scoped-define DB-AWARE no /* _UIB-PREPROCESSOR-BLOCK-END */ &ANALYZE-RESUME /* *********************** Procedure Settings ************************ */ &ANALYZE-SUSPEND _PROCEDURE-SETTINGS /* Settings for THIS-PROCEDURE Type: Procedure Allow: Frames: 0 Add Fields to: Neither Other Settings: CODE-ONLY COMPILE */ &ANALYZE-RESUME _END-PROCEDURE-SETTINGS /* ************************* Create Window ************************** */ &ANALYZE-SUSPEND _CREATE-WINDOW /* DESIGN Window definition (used by the UIB) CREATE WINDOW Procedure ASSIGN HEIGHT = 15 WIDTH = 60. /* END WINDOW DEFINITION */ */ &ANALYZE-RESUME &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure /* *************************** Main Block *************************** */ opcResult = ''. cInstallation = DYNAMIC-FUNCTION ('getInstallation':U) NO-ERROR. CREATE tParam. htParam:BUFFER-COPY(iphParam). ASSIGN cFirma = tParam.cFirma iAnzDok = 1 cERPDokumente = DYNAMIC-FUNCTION ('getFehlwert':U, cFirma, 'GEMIS_QRCODE' ) NO-ERROR. FIND bSteuer NO-LOCK WHERE bSteuer.Firma = cFirma. AdFirma = bSteuer.AdFirma. RUN AUFTRAG_ERMITTELN. IF opcResult <> '' THEN RETURN. FIND FIRST tParam. FOR EACH sAufko BY sAufko.iFak_Knr: FIND bAdresse NO-LOCK WHERE bAdresse.Firma = AdFirma AND bAdresse.Knr = sAufko.iFak_Knr. iSprcd = (IF bAdresse.Sprcd = 1 THEN 1 ELSE 4). RUN GET_FORMTEXT ( tParam.cInstall, tParam.cDokument, iSprcd, OUTPUT cFormText ) NO-ERROR. cRabText = TRIM(SUBSTRING(cFormText[21],01,20)). cZusText = TRIM(SUBSTRING(cFormText[21],21,20)). cEpzText = TRIM(SUBSTRING(cFormText[21],41,20)). RELEASE bAdresse. { vpr.i INIT } { vpr.i START } DO iLauf = 1 TO iAnzDok: dFakDatum = sAufko.dFakDat. iSeite = 0. iFaknr = sAufko.iFaknr. lFirst = TRUE. lPreis = TRUE. lLast = FALSE. EMPTY TEMP-TABLE tTotale . CREATE tTotale. FOR EACH bAufko NO-LOCK WHERE bAufko.Firma = sAufko.cFirma AND bAufko.Aufnr = sAufko.iAufnr: EMPTY TEMP-TABLE tAufze . EMPTY TEMP-TABLE tGebKto . EMPTY TEMP-TABLE tRabSumm . EMPTY TEMP-TABLE tSpeRab . EMPTY TEMP-TABLE tTabTexte . FIND bAdresse NO-LOCK USE-INDEX Adresse-k1 WHERE bAdresse.Firma = AdFirma AND bAdresse.Knr = bAufko.Fak_Knr NO-ERROR. FIND LDebst NO-LOCK USE-INDEX Debst-k1 WHERE LDebst.Firma = cFirma AND LDebst.Knr = bAufko.Knr NO-ERROR. FIND FDebst NO-LOCK USE-INDEX Debst-k1 WHERE FDebst.Firma = cFirma AND FDebst.Knr = bAufko.Fak_Knr NO-ERROR. FIND bWust NO-LOCK USE-INDEX Wust-k1 WHERE bWust.CodeK = FDebst.MWST AND bWust.CodeA = 99 NO-ERROR. lDebIncl = FALSE. IF AVAILABLE bWust THEN lDebIncl = bWust.Incl. /* Texte und Werte aus Tabelle 'Tabel' laden für RecArt */ /* FAKART, AUFSTATUS, LIEFART, FAHRER, WISO, ABLAD */ hAufko = BUFFER bAufko:HANDLE. htTabTexte = TEMP-TABLE tTabTexte:DEFAULT-BUFFER-HANDLE. RUN CREATE_TABTEXTE ( hAufko, INPUT-OUTPUT htTabTexte ) NO-ERROR. RUN FUELLEN_tAufze ( bAufko.Aufnr ) NO-ERROR. FOR EACH tAufze WHERE tAufze.Artnr > 0: FIND bAufze NO-LOCK WHERE RECID(bAufze) = tAufze.Zeile. /* Spezial-Auftragsrabatt pro Lieferschein bilden */ IF bAufze.Auf_Sp_Grp > 0 THEN DO: FIND FIRST tSpeRab WHERE tSpeRab.Rab_Grp = bAufze.Auf_Sp_Grp NO-ERROR. IF NOT AVAILABLE tSpeRab THEN DO: CREATE tSpeRab. ASSIGN tSpeRab.Rab_Grp = bAufze.Auf_Sp_Grp. END. tSpeRab.Auf_Betr = tSpeRab.Auf_Betr + bAufze.Auf_Sp_Rab. END. /* Summengruppen-Totale pro Lieferschein bilden */ DO WHILE bAufze.Rab_Su_Grp > 0: FIND FIRST tRabSumm WHERE tRabSumm.Rab_Summ = bAufze.Rab_Su_Grp NO-ERROR. IF NOT AVAILABLE tRabSumm THEN DO: FIND FIRST RabSumm NO-LOCK WHERE RabSumm.Firma = bAufze.Firma AND RabSumm.Rab_Summ = bAufze.Rab_Su_Grp NO-ERROR. IF NOT AVAILABLE RabSumm THEN LEAVE. CREATE tRabSumm. ASSIGN tRabSumm.Rab_Summ = bAufze.Rab_Su_Grp tRabSumm.Bez = RabSumm.Bez tRabSumm.Auf_Rab = 0 tRabSumm.Abh_Rab = 0. END. LEAVE. END. END. RUN DRUCKEN. REPEAT TRANSACTION: RUN AUFTRAG_GEDRUCKT ( bAufko.Aufnr ). LEAVE. END. END. END. { vpr.i STOP } END. PROCEDURE ShellExecuteA EXTERNAL "shell32.dll" : DEFINE INPUT PARAMETER lphwnd AS LONG. DEFINE INPUT PARAMETER lpOperation AS CHARACTER. DEFINE INPUT PARAMETER lpFile AS CHARACTER. DEFINE INPUT PARAMETER lpParameters AS CHARACTER. DEFINE INPUT PARAMETER lpDirectory AS CHARACTER. DEFINE INPUT PARAMETER nShowCmd AS LONG. DEFINE RETURN PARAMETER hInstance AS LONG. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME /* ********************** Internal Procedures *********************** */ &IF DEFINED(EXCLUDE-ARTIKELZEILE) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ARTIKELZEILE Procedure PROCEDURE ARTIKELZEILE : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER ipRecid AS RECID NO-UNDO. DEFINE VARIABLE cString AS CHARACTER NO-UNDO. DEFINE VARIABLE nRabWert AS DECIMAL NO-UNDO. DEFINE VARIABLE xRabText AS CHARACTER NO-UNDO. FIND tAufze WHERE RECID(tAufze) = ipRecid NO-LOCK. FIND Aufze WHERE RECID(Aufze) = tAufze.Zeile NO-LOCK. DO WHILE Aufze.Artnr = 0: RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, INPUT Aufze.Bez1 ). IF Aufze.Bez2 = '' THEN RETURN. iZeile = iZeile + 1. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, INPUT Aufze.Bez2 ). RETURN. END. FIND Artst OF Aufze NO-LOCK. FIND GGebinde NO-LOCK WHERE GGebinde.Firma = cFirma AND GGebinde.Geb_Cd = Aufze.GGeb_Cd NO-ERROR. FIND VGebinde NO-LOCK WHERE VGebinde.Firma = cFirma AND VGebinde.Geb_Cd = Aufze.VGeb_Cd NO-ERROR. FIND KGebinde NO-LOCK WHERE KGebinde.Firma = cFirma AND KGebinde.Geb_Cd = Aufze.KGeb_Cd NO-ERROR. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'B', INPUT iZeile, INPUT STRING(tAufze.Artnr,'999999') ). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, INPUT Aufze.Bez1 ). IF Aufze.Jahr > 9 THEN RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'G', INPUT iZeile, INPUT STRING(Aufze.Jahr,'9999') ). IF Aufze.Alk_Gehalt <> 0 THEN RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'H', INPUT iZeile, INPUT STRING(Aufze.Alk_Gehalt,'zz9.9%') ). IF Aufze.VGeb_Me <> 0 THEN DO: cString = STRING(Aufze.VGeb_Me,'->>>') + 'x ' + STRING(VGebinde.KBez,'x(10)'). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'I', INPUT iZeile, INPUT cString ). END. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'J', INPUT iZeile, INPUT STRING(Aufze.MBest,'->>>>>9') ). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'K', INPUT iZeile, INPUT KGebinde.KBez ). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'L', INPUT iZeile, INPUT TRIM(STRING(Aufze.Preis,'>>>>>9.99')) ). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'M', INPUT iZeile, INPUT STRING(Aufze.Bru_Betr,'->>>>>9.99') ). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'N', INPUT iZeile, INPUT STRING(Aufze.WuCd,'z9') ). IF Aufze.Bez2 <> '' THEN DO: iZeile = iZeile + 1. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, INPUT Aufze.Bez2 ). END. IF Aufze.Aktion THEN DO: iZeile = iZeile + 1. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, INPUT Aufze.Aktion_Text ). END. DO WHILE TRUE: IF Aufze.Rab_Betr = 0 THEN LEAVE. nRabWert = ABSOLUTE(Aufze.Rab_Wert). IF Aufze.Rab_Art = 3 THEN xRabText = cEpzText. ELSE DO: IF Aufze.Rab_Betr < 0 THEN xRabText = cZusText. IF Aufze.Rab_Betr > 0 THEN xRabText = cRabText. END. iZeile = iZeile + 1. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, INPUT TRIM(xRabText) ). IF Aufze.Rab_Art = 1 THEN RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'L', INPUT iZeile, INPUT TRIM(STRING(nRabWert,"->9.9 %")) ). IF Aufze.Rab_Art = 2 OR Aufze.Rab_Art = 3 THEN RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'L', INPUT iZeile, INPUT TRIM(STRING(nRabWert,"->9.99 CHF")) ). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'M', INPUT iZeile, INPUT TRIM(STRING(- Aufze.Rab_Betr ,"->>>9.99")) ). LEAVE. END. DO WHILE TRUE: IF Aufze.Zus_Betr = 0 THEN LEAVE. nRabWert = ABSOLUTE(Aufze.Zus_Wert). IF Aufze.Zus_Art = 3 THEN xRabText = cEpzText. ELSE DO: IF Aufze.Zus_Betr < 0 THEN xRabText = cRabText. IF Aufze.Zus_Betr > 0 THEN xRabText = cZusText. END. iZeile = iZeile + 1. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, INPUT TRIM(xRabText) ). IF Aufze.Zus_Art = 1 THEN RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'L', INPUT iZeile, INPUT TRIM(STRING(nRabWert,"->9.9 %")) ). IF Aufze.Zus_Art = 2 OR Aufze.Zus_Art = 3 THEN RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'L', INPUT iZeile, INPUT TRIM(STRING(nRabWert,"->9.99 CHF")) ). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'M', INPUT iZeile, INPUT TRIM(STRING(- Aufze.Zus_Betr ,"->>>9.99")) ). LEAVE. END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-AUFTRAG_ERMITTELN) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE AUFTRAG_ERMITTELN Procedure PROCEDURE AUFTRAG_ERMITTELN : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEFINE VARIABLE iAufnr AS INTEGER NO-UNDO. FIND FIRST tParam. EMPTY TEMP-TABLE sAufko. /* Sammeln aller Aufträge pro Sammelnummer */ FOR EACH Aufko NO-LOCK USE-INDEX Aufko-k5 WHERE Aufko.Firma = tParam.cFirma AND Aufko.Aufnr = tParam.iAufnr : iFaknr = Aufko.Faknr. IF iFaknr = 0 THEN DO: REPEAT TRANSACTION: iFaknr = DYNAMIC-FUNCTION('createFaknr':U, Aufko.Firma ) NO-ERROR. IF iFaknr = ? OR iFaknr = 0 THEN DO: MESSAGE 'Es konnten keine Rechnungsnummern gelöst werden' SKIP 'Ein Benutzer blockiert die Steuerdatei' VIEW-AS ALERT-BOX ERROR. NEXT. END. FIND bAufko WHERE RECID(bAufko) = RECID(Aufko). bAufko.Faknr = iFaknr. RELEASE bAufko. LEAVE. END. END. CREATE sAufko. ASSIGN sAufko.cFirma = Aufko.Firma sAufko.iAufnr = Aufko.Aufnr sAufko.iFak_Knr = Aufko.Fak_Knr sAufko.iSamm_Nr = 0 sAufko.iRecid = RECID(Aufko) sAufko.iFaknr = iFaknr. IF Aufko.Fak_Datum = ? THEN DO: sAufko.dFakDat = TODAY. REPEAT TRANSACTION: FIND bAufko WHERE RECID(bAufko) = RECID(Aufko). bAufko.Fak_Datum = sAufko.dFakDat. RELEASE bAufko. LEAVE. END. END. ELSE sAufko.dFakDat = Aufko.Fak_Datum. END. /* Alle Auftragstotale aller Lieferscheine neu rechnen */ FOR EACH sAufko: FOR EACH bAufko NO-LOCK WHERE bAufko.Firma = sAufko.cFirma AND bAufko.Faknr = sAufko.iFaknr AND bAufko.Fak_Knr = sAufko.iFak_Knr: DYNAMIC-FUNCTION('calculateAuftragsTotal':U, bAufko.Firma, bAufko.Aufnr, OUTPUT nTotale ) NO-ERROR. RELEASE bAufko. END. END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-DRUCKEN) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN Procedure PROCEDURE DRUCKEN : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEFINE VARIABLE cLAdresse AS CHARACTER NO-UNDO. DEFINE VARIABLE RText AS CHARACTER NO-UNDO. DEFINE VARIABLE WText AS CHARACTER NO-UNDO. DEFINE VARIABLE ii AS INTEGER NO-UNDO. DEFINE VARIABLE i1 AS INTEGER NO-UNDO. DEFINE VARIABLE nRabWert AS DECIMAL NO-UNDO. DEFINE VARIABLE iMwstCd AS INTEGER NO-UNDO. DEFINE VARIABLE nZeiTot AS DECIMAL DECIMALS 4 NO-UNDO. DEFINE VARIABLE cDaten AS CHARACTER NO-UNDO. DEFINE VARIABLE lInkl AS LOGICAL NO-UNDO. DEFINE VARIABLE cTel AS CHARACTER NO-UNDO. DEFINE VARIABLE lRetVal AS LOGICAL NO-UNDO. DEFINE VARIABLE cRetValue AS CHARACTER NO-UNDO. DEFINE VARIABLE cDrucker AS CHARACTER NO-UNDO. DEFINE VARIABLE cDevices AS CHARACTER NO-UNDO. FIND FIRST tParam. nFakBetr = 0. iZeile = 10. FIND bAdresse NO-LOCK WHERE bAdresse.Firma = AdFirma AND bAdresse.Knr = bAufko.Fak_Knr NO-ERROR. FIND LDebst NO-LOCK WHERE LDebst.Firma = cFirma AND LDebst.Knr = bAufko.Knr NO-ERROR. FIND FDebst NO-LOCK WHERE FDebst.Firma = cFirma AND FDebst.Knr = bAufko.Fak_Knr NO-ERROR. FIND Wust NO-LOCK WHERE Wust.CodeK = LDebst.MWST AND Wust.CodeA = 99 NO-ERROR. iSprcd = (IF bAdresse.Sprcd = 1 THEN 1 ELSE 4). IF iSeite = 0 THEN RUN EXCEL_INIT. IF RETURN-VALUE <> '' THEN DO: MESSAGE 'Problem beim Öffnen von Excel und/oder Vorlage' VIEW-AS ALERT-BOX. RETURN 'ERROR'. END. IF bAufko.Adresse[05] <> '' THEN DO: DO ii = 1 TO 5: RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'I', INPUT iZeile, INPUT bAufko.Adresse[ii] ). iZeile = iZeile + 1. END. END. ELSE DO: DO ii = 7 TO 11: RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'I', INPUT iZeile, INPUT bAdresse.Anschrift[ii] ). iZeile = iZeile + 1. END. END. iZeile = 22. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D', INPUT iZeile, INPUT STRING(dFakDatum,'99.99.9999') ). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'N', INPUT iZeile, INPUT STRING(TODAY,'99.99.9999') ). iZeile = 18. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D', INPUT iZeile, INPUT STRING(iFaknr,'>999999') ). iZeile = 20. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D', INPUT iZeile, INPUT TRIM(STRING(bAufko.Aufnr,'>>>>>>>9')) ). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'J', INPUT iZeile, INPUT bAufko.I_Best ). iZeile = 21. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D', INPUT iZeile, INPUT TRIM(STRING(bAufko.Fak_Knr,'>>>>>>9')) ). iZeile = 25. FOR EACH tAufze NO-LOCK BY tAufze.Aufnr BY tAufze.Sort1 BY tAufze.LagOrt BY tAufze.Sort2 BY tAufze.Pos : FIND Aufze NO-LOCK WHERE RECID(Aufze) = tAufze.Zeile. RUN ARTIKELZEILE ( RECID(tAufze) ). iZeile = iZeile + 1. nFakBetr = nFakBetr + Aufze.Net_Betr. RELEASE Aufze. END. iZeile = iZeile + 1. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, INPUT cFormText[13] ). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'M', INPUT iZeile, TRIM(STRING(nFakBetr,"->>>>9.99")) ). RUN SUMMENRABATTE. RUN GEBINDE_SALDO. RUN GEBINDE_ABRECHNUNG. RUN MEHRWERTSTEUER. iZeile = iZeile + 2. FIND Kondi USE-INDEX Kondi-k1 WHERE Kondi.Kond = bAufko.Kond AND Kondi.Sprcd = bAdresse.Sprcd NO-LOCK NO-ERROR. IF NOT AVAILABLE KOndi THEN DO: FIND Kondi USE-INDEX Kondi-k1 WHERE Kondi.Kond = bAufko.Kond AND Kondi.Sprcd = iSprcd NO-LOCK NO-ERROR. END. IF AVAILABLE Kondi THEN DO: RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, Kondi.Kotext ). END. hExcel:ActiveWorkbook:SAVE( ). /* hExcel:ActiveWorkbook:CLOSE( TRUE ). */ DYNAMIC-FUNCTION('RELEASEEXCEL':U, INPUT hExcel ). cDevices = SESSION:GET-PRINTERS(). cDevices = REPLACE(cDevices, ',', CHR(10)). IF tParam.lDokDruck THEN DO: DO ii = 1 TO NUM-ENTRIES(cDevices, CHR(10)): cDrucker = ENTRY(ii, cDevices, CHR(10)). IF cDrucker <> tParam.Drucker THEN NEXT. RUN CHECKPRINTER ( cDrucker , OUTPUT lRetVal ) NO-ERROR. LEAVE. END. IF lRetVal THEN DO: MESSAGE 'gewählter Drucker kann nicht angesprochen werden' VIEW-AS ALERT-BOX INFORMATION BUTTONS OK. END. END. FIND FIRST tAufko NO-ERROR. IF NOT AVAILABLE tAufko THEN CREATE tAufko. BUFFER-COPY bAufko TO tAufko. tAufko.lBetrag = (IF tAufko.Auf_Tot > 0 THEN TRUE ELSE FALSE). RUN DRUCKEN_QRCODE. cRetValue = RETURN-VALUE. RUN vpr_EndDoc. IF cRetValue <> '' THEN RETURN. cFileName = SUBSTITUTE('&1-&2_&3.vpr', STRING(bAufko.Knr ,'999999'), STRING(bAufko.Faknr,'9999999'), tParam.cDokument ). cVPRDocument = SUBSTITUTE(cERPDokumente, cFileName ) . RUN vpr_saveDoc ( cVPRDocument ). DO WHILE tParam.lDokDruck: SESSION:PRINTER-NAME = tParam.Drucker NO-ERROR. IF SESSION:PRINTER-NAME <> tParam.Drucker THEN DO: RUN vpr_printerDialog ( OUTPUT lJa ). IF NOT lJa THEN LEAVE. END. RUN vpr_printDoc (0, 0). RUN vpr_resetDoc. LEAVE. END. IF tParam.lCreatePDF THEN DO: cPDFDocument = REPLACE(cVPRDocument, '.vpr', '.pdf'). RUN vpr_openDoc ( cVPRDocument ). RUN vpr_printPDF ( 0, 0, INPUT-OUTPUT cPDFDocument ). END. IF tParam.lOpenPDF THEN DO: DEFINE VARIABLE o-i AS i NO-UNDO. FILE-INFO:FILE-NAME = cPDFDocument. cPDFDocument = FILE-INFO:FULL-PATHNAME. RUN ShellExecuteA (0, "open", cPDFDocument, "", "", 0, OUTPUT o-i). END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-DRUCKEN_QRCODE) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_QRCODE Procedure PROCEDURE DRUCKEN_QRCODE: /*------------------------------------------------------------------------------*/ /* Purpose: */ /* Parameters: */ /* Notes: */ /*------------------------------------------------------------------------------*/ DEFINE VARIABLE cFileName AS CHARACTER NO-UNDO. DEFINE VARIABLE cString AS CHARACTER NO-UNDO. DEFINE VARIABLE hAufko AS HANDLE NO-UNDO. DEFINE VARIABLE cBesrTemplate AS CHARACTER NO-UNDO INIT 'viper/realwines/BESR_QR.vfr'. DEFINE VARIABLE cWerbung AS CHARACTER NO-UNDO. DEFINE VARIABLE cConString AS CHARACTER NO-UNDO. DEFINE VARIABLE i1 AS INTEGER NO-UNDO. FIND FIRST tAufko. hAufko = TEMP-TABLE tAufko:DEFAULT-BUFFER-HANDLE. IF tAufko.Auf_Tot <= 0 THEN RETURN 'NULL'. FIND FIRST tParam. cPathQRCodes = DYNAMIC-FUNCTION ('getFehlwert':U, tParam.Firma, 'GEMIS_QRCODE') NO-ERROR. cWerbung = DYNAMIC-FUNCTION ('getFehlwert':U, tParam.Firma, 'WERBUNG_QRCODE') NO-ERROR. FIND FIRST ViperDoc NO-LOCK WHERE ViperDoc.Firma = tAufko.Firma AND ViperDoc.Benutzer = '' AND ViperDoc.Formular = 'BESR_QR' AND ViperDoc.DokArt = 0 NO-ERROR. IF NOT AVAILABLE ViperDoc THEN RETURN 'NULL'. RUN vpr_ResetDoc. RUN vpr_LoadVFR (cBesrTemplate). RUN vpr_ActivateReport ('BESR_QR'). RUN vpr_SelectPrinter (tParam.Drucker). RUN vpr_setPrinterAttrib('duplex=1'). RUN vpr_SetPrinterAttrib('copies=1'). RUN vpr_SetDocAttrib ('PAPERSIZE=A4'). RUN vpr_SetPreviewMode ('Direct'). RUN vpr_InitGroups (""). RUN vpr_initGraphObj. RUN vpr_setDocTitle ( SUBSTITUTE('QRCODE_Knr-&1_Faknr-&2.pdf':U, STRING(tAufko.Knr,'999999'), STRING(tAufko.Faknr,'9999999')) ). RUN vpr_SetDelimiter (CHR(01)). RUN vpr_SetCurrentPageProperties("Papertray", ViperDoc.Schacht_BESR). cFileName = SUBSTITUTE('&1&2_&3', cPathQRCodes, 'QR_CODE', STRING(bAufko.Aufnr,'9999999')). RUN 'SwissQR/SwissQRCode.p' ( hAufko, cFileName ). cFilename = cFileName + '.jpg'. IF SEARCH(cFileName) <> ? THEN DO: cFileName = 'FILENAME=' + cFileName. RUN vpr_setGraphObjAttrib ( 'QRCode', 'QRCODE', cFileName ). END. cWerbung = SUBSTITUTE(cPathWerbung, tParam.cInstall). cWerbung = SUBSTITUTE('&1Werbung_&2.jpg', cWerbung, tAufko.Firma). IF SEARCH(cWerbung) <> ? THEN DO: cWerbung = SUBSTITUTE('FILENAME=&1', cWerbung). RUN vpr_setGraphObjAttrib ( 'Werbung', 'QRCODE', cWerbung ). END. RUN vpr_InitGraphObj. RUN vpr_flushGroup('QRCODE'). RETURN ''. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-EXCEL_INIT) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE EXCEL_INIT Procedure PROCEDURE EXCEL_INIT : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEFINE VARIABLE cVorlage AS CHARACTER NO-UNDO. DEFINE VARIABLE cPfad AS CHARACTER NO-UNDO. DEFINE VARIABLE lRetVal AS LOG NO-UNDO. DEFINE VARIABLE xTemplate AS CHARACTER NO-UNDO. DEFINE VARIABLE xDokument AS CHARACTER NO-UNDO. DEFINE VARIABLE xSprcd AS INTEGER NO-UNDO. FIND FIRST tParam. hExcel = DYNAMIC-FUNCTION('CREATEEXCEL':U) NO-ERROR. IF NOT VALID-HANDLE(hExcel) THEN RETURN 'ERROR'. xSprcd = (IF iSprcd <> 1 THEN 2 ELSE 1). cPfad = DYNAMIC-FUNCTION ('getFehlwert':U, tParam.Firma, 'EXCEL_FORMULARE') NO-ERROR. IF cPfad = ? THEN cPfad = ''. IF cPfad = '' THEN cPfad = SESSION:TEMP-DIR. ELSE DO: FILE-INFO:FILE-NAME = cPfad. cPfad = FILE-INFO:FULL-PATHNAME. cPfad = REPLACE(cPfad, '\', '/'). END. xTemplate = SUBSTITUTE(tParam.Template, STRING(bAufko.Ku_Grp,'99'), STRING(xSprcd,'99'), bAufko.Frw ). xDokument = SUBSTITUTE(tParam.Template, STRING(bAufko.Faknr ,'999999'), STRING(bAufko.Knr,'999999'), bAufko.Frw ). cVorlage = xDokument + CHR(01) + 'viper\realwines\' + xTemplate + CHR(01) + cPfad. RUN CREATEDATEI ( INPUT cVorlage ). cExcelDocument = RETURN-VALUE. IF cExcelDocument BEGINS 'ERROR' THEN DO: MESSAGE 'Keine gültige Vorlage gefunden ' cVorlage VIEW-AS ALERT-BOX INFORMATION BUTTONS OK. RETURN 'ERROR'. END. cExcelDocument = REPLACE(cExcelDocument, '.\' , ''). cExcelDocument = REPLACE(cExcelDocument, '..\', ''). FILE-INFO:FILE-NAME = cExcelDocument NO-ERROR. cExcelDocument = FILE-INFO:FULL-PATHNAME. RUN OPENEXCEL ( INPUT hExcel, INPUT cExcelDocument, INPUT '', OUTPUT lRetVal ). IF NOT lRetVal THEN DO: IF VALID-HANDLE(hExcel) THEN RUN RELEASEEXCEL ( INPUT hExcel ). RETURN 'ERROR'. END. RETURN ''. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-FUELLEN_tAufze) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE FUELLEN_tAufze Procedure PROCEDURE FUELLEN_tAufze : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEFINE INPUT PARAMETER ipAufnr AS INTEGER NO-UNDO. DEFINE VARIABLE minPos AS INTEGER NO-UNDO. DEFINE VARIABLE maxPos AS INTEGER NO-UNDO. DEFINE VARIABLE jPlatz AS INTEGER NO-UNDO. DEFINE VARIABLE cLagOrt AS CHARACTER NO-UNDO. DEFINE VARIABLE iRuestArt AS INTEGER NO-UNDO. DEFINE VARIABLE iPlusMinus AS INTEGER NO-UNDO. DEFINE VARIABLE lArtikel AS LOG NO-UNDO. EMPTY TEMP-TABLE tAufze. FIND Steuer NO-LOCK WHERE Steuer.Firma = cFirma NO-ERROR. IF AVAILABLE Steuer THEN iRuestArt = Steuer.RuestArt. ASSIGN minPos = 0 maxPos = 9999 iPlusMinus = 0. /* Kommentar zu Beginn eines Auftrages */ lArtikel = FALSE. FOR EACH Aufze NO-LOCK WHERE Aufze.Firma = cFirma AND Aufze.Aufnr = ipAufnr AND Aufze.Pos > minPos: IF Aufze.Artnr > 0 THEN DO: lArtikel = TRUE. LEAVE. END. minPos = Aufze.Pos. CREATE tAufze. ASSIGN tAufze.Aufnr = Aufze.Aufnr tAufze.Artnr = Aufze.Artnr tAufze.Inhalt = Aufze.Inhalt tAufze.Jahr = Aufze.Jahr tAufze.Pos = Aufze.Pos tAufze.Zeile = RECID(Aufze) tAufze.Aktion = Aufze.Aktion tAufze.Preis = Aufze.Preis tAufze.MGeli = Aufze.MGeli tAufze.MRuek = Aufze.MRuek. ASSIGN tAufze.Sort1 = STRING(0,'99') tAufze.Sort2 = '' tAufze.Sort3 = STRING(tAufze.Artnr ,'999999') + STRING(tAufze.Inhalt,'9999') + STRING(tAufze.Jahr ,'9999') + STRING(iPlusMinus ,'9') + STRING(tAufze.Pos ,'99999'). tAufze.LagOrt = ''. END. /* Kommentar am Ende eines Auftrages */ IF lArtikel THEN DO: FOR EACH Aufze NO-LOCK WHERE Aufze.Firma = cFirma AND Aufze.Aufnr = ipAufnr BY Aufze.Pos DESCENDING: IF Aufze.Artnr > 0 THEN LEAVE. maxPos = Aufze.Pos. CREATE tAufze. ASSIGN tAufze.Aufnr = Aufze.Aufnr tAufze.Artnr = Aufze.Artnr tAufze.Inhalt = Aufze.Inhalt tAufze.Jahr = Aufze.Jahr tAufze.Pos = Aufze.Pos tAufze.Zeile = RECID(Aufze) tAufze.Aktion = Aufze.Aktion tAufze.Preis = Aufze.Preis tAufze.MGeli = Aufze.MGeli tAufze.MRuek = Aufze.MRuek. ASSIGN tAufze.Sort1 = STRING(0,'99') tAufze.Sort2 = '' tAufze.Sort3 = STRING(tAufze.Artnr ,'999999') + STRING(tAufze.Inhalt,'9999') + STRING(tAufze.Jahr ,'9999') + STRING(iPlusMinus ,'9') + STRING(tAufze.Pos ,'99999'). tAufze.LagOrt = ''. END. END. /* Artikelzeilen nach Ruestplatz und Ort */ cLagOrt = ''. FOR EACH Aufze NO-LOCK WHERE Aufze.Firma = cFirma AND Aufze.Aufnr = ipAufnr AND Aufze.Pos > minPos AND Aufze.Pos < MaxPos BY Aufze.Pos DESCENDING: IF Aufze.Artnr > 0 THEN DO: FIND ArtLager NO-LOCK WHERE ArtLager.Firma = Aufze.Firma AND ArtLager.Artnr = Aufze.Artnr AND ArtLager.Inhalt = Aufze.Inhalt AND ArtLager.Jahr = Aufze.Jahr AND ArtLager.Lager = Aufze.Lager. cLagOrt = ArtLager.Ort. END. iPlusMinus = (IF Aufze.MGeli < 0 THEN 1 ELSE 0). FIND LAST RuestPlatz USE-INDEX RuestPlatz-k2 WHERE RuestPlatz.Firma = Aufze.Firma AND RuestPlatz.RuestArt = iRuestArt AND RuestPlatz.abLagOrt <= cLagOrt NO-ERROR. IF NOT AVAILABLE RuestPlatz THEN jPlatz = 90. ELSE jPlatz = RuestPlatz.Platz. CREATE tAufze. ASSIGN tAufze.Aufnr = Aufze.Aufnr tAufze.Artnr = Aufze.Artnr tAufze.Inhalt = Aufze.Inhalt tAufze.Jahr = Aufze.Jahr tAufze.Pos = Aufze.Pos tAufze.Zeile = RECID(Aufze) tAufze.Aktion = Aufze.Aktion tAufze.Preis = Aufze.Preis tAufze.MGeli = Aufze.MGeli tAufze.MRuek = Aufze.MRuek. ASSIGN tAufze.Sort1 = STRING(jPlatz,'99') tAufze.Sort2 = cLagOrt tAufze.Sort3 = STRING(tAufze.Artnr ,'999999') + STRING(tAufze.Inhalt,'9999') + STRING(tAufze.Jahr ,'9999') + STRING(iPlusMinus ,'9') + STRING(tAufze.Pos ,'99999'). tAufze.LagOrt = cLagort. IF tAufze.Artnr > 0 AND tAufze.MGeli = 0 THEN DELETE tAufze. END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-GEBINDE_ABRECHNUNG) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE GEBINDE_ABRECHNUNG Procedure PROCEDURE GEBINDE_ABRECHNUNG : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEFINE VARIABLE cDaten AS CHARACTER NO-UNDO. DEFINE VARIABLE lTotal AS LOG NO-UNDO. DEFINE VARIABLE nBetrag AS DECIMAL NO-UNDO. DEFINE VARIABLE i1 AS INTEGER NO-UNDO. DEFINE VARIABLE i2 AS INTEGER NO-UNDO. DEFINE VARIABLE iMwstCd AS INTEGER NO-UNDO. DEFINE VARIABLE nZTot AS DECIMAL NO-UNDO. lTotal = FALSE. i2 = 0. nZTot = 0. FOR EACH AufGKon NO-LOCK WHERE AufGKon.Firma = BAufko.Firma AND AufGKon.Aufnr = BAufko.Aufnr AND AufGKon.Gebuehr <> 0 AND AufGKon.Betrag <> 0 : iMwstCd = AufGKon.MWST_Cd. IF i2 = 0 THEN iZeile = iZeile + 2. ELSE iZeile = iZeile + 1. FIND GebKonto NO-LOCK WHERE GebKonto.Firma = cFirma AND GebKonto.Geb_Cd = AufGKon.Geb_Cd. i1 = AufGKon.Ausgang. IF AufGKon.Depot = 0 AND AufGKon.Gebuehr = 0 THEN nBetrag = GebKonto.Depot + GebKonto.Gebuehr. ELSE nBetrag = AufGKon.Depot + AufGKon.Gebuehr. Rundbetr = i1 * nBetrag. iMwstCd = AufGKon.MWSt_Cd. nZTot = nZTot + Rundbetr. cDaten = GebKonto.Bez. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, INPUT cDaten ). cDaten = TRIM(STRING(AufGKon.Ausgang,"->>>>9")). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'K', INPUT iZeile, INPUT cDaten ). cDaten = TRIM(STRING(nBetrag,"->>>>9.999")). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'L', INPUT iZeile, INPUT cDaten ). cDaten = TRIM(STRING(Rundbetr,"->>>>9.999")). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'M', INPUT iZeile, INPUT cDaten ). cDaten = TRIM(STRING(iMwstCd,"z9")). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'N', INPUT iZeile, INPUT cDaten ). i2 = i2 + 1. END. IF i2 > 0 THEN lTotal = TRUE. IF lTotal THEN DO: iZeile = iZeile + 2. cDaten = TRIM(SUBSTRING(cFormText[11],41,20)). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, INPUT cDaten ). cdaten = TRIM(STRING(nZTot,"->>>>9.99")). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'M', INPUT iZeile, INPUT cDaten ). nFakBetr = nFakBetr + nZTot. END. RELEASE AufGKon. lTotal = FALSE. i2 = 0. nZTot = 0. FOR EACH AufGKon NO-LOCK WHERE AufGKon.Firma = BAufko.Firma AND AufGKon.Aufnr = BAufko.Aufnr AND AufGKon.Depot <> 0 : IF AufGKon.Eingang = 0 AND AufGKon.Ausgang = 0 THEN NEXT. IF i2 = 0 THEN iZeile = iZeile + 2. ELSE iZeile = iZeile + 1. FIND GebKonto NO-LOCK WHERE GebKonto.Firma = cFirma AND GebKonto.Geb_Cd = AufGKon.Geb_Cd. i1 = AufGKon.Ausgang. IF AufGKon.Depot = 0 AND AufGKon.Gebuehr = 0 THEN nBetrag = GebKonto.Depot + GebKonto.Gebuehr. ELSE nBetrag = AufGKon.Depot + AufGKon.Gebuehr. Rundbetr = i1 * nBetrag. iMwstCd = AufGKon.MWSt_Cd. nZTot = nZTot + Rundbetr. cDaten = GebKonto.Bez. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, INPUT cDaten ). cDaten = TRIM(STRING(AufGKon.Ausgang,"->>>>9")). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'K', INPUT iZeile, INPUT cDaten ). cDaten = TRIM(STRING(nBetrag,"->>>>9.999")). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'L', INPUT iZeile, INPUT cDaten ). cDaten = TRIM(STRING(Rundbetr,"->>>>9.999")). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'M', INPUT iZeile, INPUT cDaten ). cDaten = TRIM(STRING(iMwstCd,"z9")). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'N', INPUT iZeile, INPUT cDaten ). i2 = i2 + 1. END. IF i2 > 0 THEN lTotal = TRUE. IF lTotal THEN DO: iZeile = iZeile + 2. cDaten = TRIM(SUBSTRING(cFormText[11],21,20)). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, INPUT cDaten ). cdaten = TRIM(STRING(nZTot,"->>>>9.99")). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'M', INPUT iZeile, INPUT cDaten ). nFakBetr = nFakBetr + nZTot. END. IF lTotal THEN DO: iZeile = iZeile + 2. cDaten = TRIM(SUBSTRING(cFormText[15],21,20)). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, INPUT cDaten ). cDaten = TRIM(STRING(nFakBetr,"->>>>9.99")). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'M', INPUT iZeile, INPUT cDaten ). END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-GEBINDE_SALDO) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE GEBINDE_SALDO Procedure PROCEDURE GEBINDE_SALDO : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ FOR EACH AufGKon NO-LOCK WHERE AufGKon.Firma = BAufko.Firma AND AufGKon.Aufnr = BAufko.Aufnr AND AufGKon.Depot <> 0 AND AufGKon.Betrag <> 0 : FIND FIRST tGebKto WHERE tGebKto.Geb_Cd = AufGKon.Geb_Cd NO-ERROR. IF NOT AVAILABLE tGebKto THEN DO: FIND GebKonto NO-LOCK WHERE GebKonto.Firma = AufGKon.Firma AND GebKonto.Geb_Cd = AufGKon.Geb_Cd . CREATE tGebKto. ASSIGN tGebKto.Sort_Cd = GebKonto.Sort_Cd tGebKto.Geb_Cd = GebKonto.Geb_Cd tGebKto.Bez = GebKonto.Bez tGebKto.Preis = AufGKon.Depot tGebKto.MWST_Cd = AufGKon.MWSt_Cd. END. tGebKto.A_Anz = tGebKto.A_Anz + AufGKon.Ausgang. tGebKto.A_Betrag = tGebKto.A_Anz * tGebKto.Preis. tGebKto.E_Anz = tGebKto.E_Anz + AufGKon.Eingang. tGebKto.E_Betrag = tGebKto.E_Anz * tGebKto.Preis. END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-MEHRWERTSTEUER) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE MEHRWERTSTEUER Procedure PROCEDURE MEHRWERTSTEUER : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEFINE VARIABLE cDaten AS CHARACTER NO-UNDO. DEFINE VARIABLE ix AS INTEGER NO-UNDO. DEFINE VARIABLE nMwst AS DECIMAL NO-UNDO. DEFINE VARIABLE cMwst AS CHARACTER NO-UNDO. DEFINE VARIABLE nTotMwst AS DECIMAL NO-UNDO. iZeile = iZeile + 1. nTotMwst = 0. DO ix = 1 TO 11: IF bAufko.Wpfl[ix] = 0 THEN NEXT. FIND LAST MWSTAns NO-LOCK USE-INDEX MWSTAns-k1 WHERE MWSTAns.MWST_Cd = ix AND MWSTAns.Datum <= BAUfko.Kond_Datum . iZeile = iZeile + 1. cDaten = (IF bAufko.Wust[ix] = 0 THEN cFormText[19] ELSE cFormText[20]). cDaten = SUBSTITUTE(cDaten, TRIM(STRING(MWSTAns.Ansatz,'>>9.99%'))). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, INPUT cDaten ). cDaten = TRIM(STRING(bAufko.Wpfl[ix],"->>,>>9.99")). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'L', INPUT iZeile, INPUT cDaten ). nMwst = (IF bAufko.Wust[ix] <> 0 THEN bAufko.Wust[ix] ELSE bAufko.Wpfl[ix] / (100 + MWSTAns.Ansatz) * MWSTAns.Ansatz). cDaten = TRIM(STRING(nMwst,"->>,>>9.99")). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'M', INPUT iZeile, INPUT cDaten ). cDaten = TRIM(STRING(ix,"z9")). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'N', INPUT iZeile, INPUT cDaten ). nFakBetr = nFakBetr + bAufko.Wust[ix]. nTotMwst = nTotMwst + bAufko.Wust[ix]. IF ix < 8 THEN nTotMwst = nTotMwst + 1. END. Rundbetr = nFakBetr. Rundcode = 1. RUN RUNDEN ( Rundcode, INPUT-OUTPUT Rundbetr ). nFakBetr = Rundbetr. iZeile = iZeile + 2. cDaten = (IF nTotMwst = 0 THEN TRIM(SUBSTRING(cFormText[16],41)) ELSE TRIM(SUBSTRING(cFormText[16],01,40)) ). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, INPUT cDaten ). cDaten = TRIM(STRING(nFakBetr,"->>,>>9.99")). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'M', INPUT iZeile, INPUT cDaten ). END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF &IF DEFINED(EXCLUDE-SUMMENRABATTE) = 0 &THEN &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE SUMMENRABATTE Procedure PROCEDURE SUMMENRABATTE : /*------------------------------------------------------------------------------ Purpose: Parameters: Notes: ------------------------------------------------------------------------------*/ DEFINE VARIABLE RText AS CHARACTER FORMAT "x(20)" NO-UNDO. DEFINE VARIABLE WText AS CHARACTER NO-UNDO. DEFINE VARIABLE cDaten AS CHARACTER NO-UNDO. DEFINE VARIABLE lTotal AS LOG NO-UNDO. DEFINE VARIABLE lRabatt AS LOG NO-UNDO. DEFINE VARIABLE iPlus AS INTEGER NO-UNDO. DEFINE VARIABLE nRabWert AS DECIMAL NO-UNDO. DEFINE VARIABLE iMwstCd AS INTEGER NO-UNDO. /* Auftragsrabatt ---------------------------------------------------- */ lTotal = FALSE. iPlus = 0. FOR EACH tRabSumm WHERE tRabSumm.Auf_Rab <> 0 BY tRabSumm.Rab_Summ: Rundbetr = tRabSumm.Auf_Rab. nFakBetr = nFakBetr - Rundbetr. IF NOT lRabatt THEN NEXT. IF iPlus = 0 THEN iZeile = iZeile + 2. ELSE iZeile = iZeile + 1. IF Rundbetr < 0 THEN RText = cZusText. ELSE RText = cRabText. FIND FIRST AufRabSu NO-LOCK USE-INDEX AufRabSu-k1 WHERE AufRabSu.Firma = bAufko.Firma AND AufRabSu.Aufnr = bAufko.Aufnr AND AufRabSu.Rab_Summ = tRabSumm.Rab_Summ. IF AufRabSu.F_Proz_Betr THEN WText = "%". ELSE WText = "Fr.". nRabWert = ABSOLUT(AufRabSu.F_Wert). cDaten = RText + " " + tRabSumm.Bez + " " + STRING(nRabWert,"z9.99- ") + WText. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, INPUT cDaten ). cDaten = STRING(- Rundbetr,"->>>>9.99"). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'M', INPUT iZeile, INPUT cDaten ). iPlus = iPlus + 1. END. IF iPlus > 0 THEN lTotal = TRUE. /* Abholrabatt ------------------------------------------------------- */ iPlus = 0. FOR EACH tRabSumm WHERE tRabSumm.Abh_Rab <> 0 BY tRabSumm.Rab_Summ: Rundbetr = tRabSumm.Abh_Rab. nFakBetr = nFakBetr - Rundbetr. IF NOT lRabatt THEN NEXT. IF iPlus = 0 THEN iZeile = iZeile + 2. ELSE iZeile = iZeile + 1. IF Rundbetr < 0 THEN RText = cZusText. ELSE RText = cRabText. FIND FIRST AufRabSu NO-LOCK USE-INDEX AufRabSu-k1 WHERE AufRabSu.Firma = bAufko.Firma AND AufRabSu.Aufnr = bAufko.Aufnr AND AufRabSu.Rab_Summ = tRabSumm.Rab_Summ. IF AufRabSu.A_Proz_Betr THEN WText = "%". ELSE WText = "Fr.". nRabWert = ABSOLUT(AufRabSu.A_Wert). cDaten = RText + " " + tRabSumm.Bez + " " + STRING(nRabWert,"z9.99- ") + WText. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, INPUT cDaten ). cDaten = STRING(- Rundbetr,"->>>>9.99"). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'M', INPUT iZeile, INPUT cDaten ). iPlus = iPlus + 1. END. IF iPlus > 0 THEN lTotal = TRUE. /* Spezialpreis-Auftragsrabatte ---------------------------------------- */ iPlus = 0. FOR EACH tSpeRab WHERE tSpeRab.Auf_Betr <> 0 BY tSpeRab.Rab_Grp: Rundbetr = tSpeRab.Auf_Betr. nFakBetr = nFakBetr - Rundbetr. IF NOT lRabatt THEN NEXT. IF iPlus = 0 THEN iZeile = iZeile + 2. ELSE iZeile = iZeile + 1. IF Rundbetr < 0 THEN RText = cZusText. ELSE RText = cRabText. FIND Tabel NO-LOCK WHERE Tabel.Firma = cFirma AND Tabel.RecArt = 'ARABGRP' AND Tabel.CodeC = '' AND Tabel.CodeI = tSpeRab.Rab_Grp AND Tabel.Sprcd = 1 . FIND FIRST AufSpRab NO-LOCK WHERE AufSpRab.Firma = bAufko.Firma AND AufSpRab.Aufnr = bAufko.Aufnr AND AufSpRab.Rab_Grp = tSpeRab.Rab_Grp. IF AufSpRab.Auf_Proz_Betr THEN WText = "%". ELSE WText = "Fr.". nRabWert = ABSOLUT(AufSpRab.Auf_Wert). cDaten = RText + " " + tRabSumm.Bez + " " + STRING(nRabWert,"z9.99- ") + WText. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, INPUT cDaten ). cDaten = STRING(- Rundbetr,"->>>>9.99"). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'M', INPUT iZeile, INPUT cDaten ). iPlus = iPlus + 1. END. IF iPlus > 0 THEN lTotal = TRUE. IF lTotal THEN DO: iZeile = iZeile + 1. cDaten = TRIM(SUBSTRING(cFormText[14],21,20)). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, INPUT cDaten ). cDaten = TRIM(STRING(nFakBetr,"->>>>9.99")). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'M', INPUT iZeile, INPUT cDaten ). END. /* Recycling-Gebühren ------------------------------------------------ */ lTotal = FALSE. iPlus = 0. FOR EACH AufGKon NO-LOCK WHERE AufGKon.Firma = bAufko.Firma AND AufGKon.Aufnr = bAufko.Aufnr AND AufGKon.Gebuehr <> 0 AND AufGKon.Betrag <> 0 : nFakBetr = nFakBetr + AufGKon.Betrag. IF NOT lRabatt THEN NEXT. IF iPlus = 0 THEN iZeile = iZeile + 2. ELSE iZeile = iZeile + 1. iMwstCd = AufGKon.MWSt_Cd. FIND GebKonto OF AufGKon NO-LOCK NO-ERROR. IF NOT AVAILABLE GebKonto THEN cDaten = TRIM(SUBSTRING(cFormText[11],41,20)). ELSE cDaten = GebKonto.Bez. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, INPUT cDaten ). cDaten = TRIM(STRING(AufGKon.Ausgang,"->>>>>9")). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'L', INPUT iZeile, INPUT cDaten ). cDaten = TRIM(STRING(AufGKon.Betrag,"->>>>9.99")). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'M', INPUT iZeile, INPUT cDaten ). cDaten = TRIM(STRING(AufGKon.MWSt_Cd ,"z9")). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'N', INPUT iZeile, INPUT cDaten ). iPlus = iPlus + 1. END. IF iPlus > 0 THEN lTotal = TRUE. IF lTotal THEN DO: iZeile = iZeile + 1. cDaten = TRIM(SUBSTRING(cFormText[14],21,20)). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C', INPUT iZeile, INPUT cDaten ). cDaten = TRIM(STRING(nFakBetr,"->>>>9.99")). RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'M', INPUT iZeile, INPUT cDaten ). END. END PROCEDURE. /* _UIB-CODE-BLOCK-END */ &ANALYZE-RESUME &ENDIF