| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984 |
- &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI ADM1
- &ANALYZE-RESUME
- /* Connected Databases
- anadat PROGRESS
- */
- &Scoped-define WINDOW-NAME CURRENT-WINDOW
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS F-Frame-Win
- /*------------------------------------------------------------------------
- File:
- Description: from cntnrfrm.w - ADM SmartFrame Template
- Input Parameters:
- <none>
- Output Parameters:
- <none>
-
- ------------------------------------------------------------------------*/
- /* This .W file was created with the Progress UIB. */
- /*----------------------------------------------------------------------*/
- /* Create an unnamed pool to store all the widgets created
- by this procedure. This is a good default which assures
- that this procedure's triggers and internal procedures
- will execute in this procedure's storage, and that proper
- cleanup will occur on deletion of the procedure. */
- CREATE WIDGET-POOL.
- /* *************************** Definitions ************************** */
- /* Parameters Definitions --- */
- /* Local Variable Definitions --- */
- DEF VAR VVonDatum AS DATE FORMAT "99.99.9999" NO-UNDO.
- DEF VAR VBisDatum AS DATE FORMAT "99.99.9999" NO-UNDO.
- DEF VAR VKnr AS INT NO-UNDO.
- DEF VAR VAnschrift LIKE Adresse.Anschrift NO-UNDO.
- DEF VAR VZelle AS CHAR NO-UNDO.
- DEF VAR VTotal AS DEC EXTENT 10 NO-UNDO.
- DEF VAR VRabatt AS CHAR NO-UNDO.
- DEF VAR VTemp AS CHAR NO-UNDO.
- DEF VAR VAdresse AS CHAR FORMAT "x(10)" NO-UNDO.
- DEF VAR iLager AS INT NO-UNDO.
- DEF VAR excelAppl AS COM-HANDLE NO-UNDO.
- DEF TEMP-TABLE TWork FIELD SummGrp AS INT
- FIELD MWST% AS DEC
- FIELD Menge AS DEC
- FIELD Liter AS DEC
- FIELD Betrag AS DEC
- FIELD Bonus AS DEC
-
- INDEX TWork-k1 IS UNIQUE PRIMARY
- SummGrp
- MWST%.
- DEF BUFFER BBonusAbr FOR BonusAbr.
-
- DEF NEW SHARED VAR VBuchen AS DEC EXTENT 10.
- DEF NEW SHARED VAR VAnsatz AS DEC EXTENT 10.
- /* ---------- Globale Variablen ---------------------------------- */
- { v8/globvar.i" " " " "SHARED" }
- { v8/debivar.i " " " " "SHARED" }
- { v8/artivar.i " " " " "SHARED" }
- { v8/contvar.i " " " " "SHARED" }
- { v8/listtitv.i "NEW" "SHARED" }
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
- /* ******************** Preprocessor Definitions ******************** */
- &Scoped-define PROCEDURE-TYPE SmartFrame
- &Scoped-define DB-AWARE no
- &Scoped-define ADM-CONTAINER FRAME
- /* Name of first Frame and/or Browse and/or first Query */
- &Scoped-define FRAME-NAME F-Main
- &Scoped-define BROWSE-NAME Br_Bonus_1
- /* Internal Tables (found by Frame, Query & Browse Queries) */
- &Scoped-define INTERNAL-TABLES BonusAbr
- /* Definitions for BROWSE Br_Bonus_1 */
- &Scoped-define FIELDS-IN-QUERY-Br_Bonus_1 BonusAbr.Knr VAdresse @ VAdresse ~
- BonusAbr.VonDatum BonusAbr.Artnr BonusAbr.Inhalt BonusAbr.Jahr ~
- BonusAbr.Menge BonusAbr.Volumen BonusAbr.Betrag BonusAbr.Bonus
- &Scoped-define ENABLED-FIELDS-IN-QUERY-Br_Bonus_1
- &Scoped-define QUERY-STRING-Br_Bonus_1 FOR EACH BonusAbr ~
- WHERE BonusAbr.Firma = GVFirma ~
- AND BonusAbr.Bon_Sta = 1 NO-LOCK
- &Scoped-define OPEN-QUERY-Br_Bonus_1 OPEN QUERY Br_Bonus_1 FOR EACH BonusAbr ~
- WHERE BonusAbr.Firma = GVFirma ~
- AND BonusAbr.Bon_Sta = 1 NO-LOCK.
- &Scoped-define TABLES-IN-QUERY-Br_Bonus_1 BonusAbr
- &Scoped-define FIRST-TABLE-IN-QUERY-Br_Bonus_1 BonusAbr
- /* Definitions for FRAME F-Main */
- &Scoped-define OPEN-BROWSERS-IN-QUERY-F-Main ~
- ~{&OPEN-QUERY-Br_Bonus_1}
- /* Standard List Definitions */
- &Scoped-Define ENABLED-OBJECTS RECT-21 Br_Bonus_1
- /* Custom List Definitions */
- /* List-1,List-2,List-3,List-4,List-5,List-6 */
- /* _UIB-PREPROCESSOR-BLOCK-END */
- &ANALYZE-RESUME
- /* *********************** Control Definitions ********************** */
- /* Definitions of the field level widgets */
- DEFINE BUTTON Btn_Excel
- LABEL "&Excel"
- SIZE 14 BY 1.24.
- DEFINE RECTANGLE RECT-21
- EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL
- SIZE 123.8 BY 14.24.
- /* Query definitions */
- &ANALYZE-SUSPEND
- DEFINE QUERY Br_Bonus_1 FOR
- BonusAbr SCROLLING.
- &ANALYZE-RESUME
- /* Browse definitions */
- DEFINE BROWSE Br_Bonus_1
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _DISPLAY-FIELDS Br_Bonus_1 F-Frame-Win _STRUCTURED
- QUERY Br_Bonus_1 DISPLAY
- BonusAbr.Knr FORMAT "z999999":U
- VAdresse @ VAdresse COLUMN-LABEL "Kunde" FORMAT "x(30)":U
- BonusAbr.VonDatum COLUMN-LABEL "Datum" FORMAT "99.99.9999":U
- BonusAbr.Artnr FORMAT "z999999":U
- BonusAbr.Inhalt FORMAT "9999":U
- BonusAbr.Jahr FORMAT "z9999":U
- BonusAbr.Menge FORMAT "z,zzz,zz9-":U
- BonusAbr.Volumen FORMAT "z,zzz,zz9-":U
- BonusAbr.Betrag FORMAT "z,zzz,zz9-":U
- BonusAbr.Bonus FORMAT "zz,zz9.99-":U
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- WITH NO-ROW-MARKERS SEPARATORS SIZE 122 BY 10.95
- BGCOLOR 15 .
- /* ************************ Frame Definitions *********************** */
- DEFINE FRAME F-Main
- Br_Bonus_1 AT ROW 1.48 COL 3
- Btn_Excel AT ROW 13.38 COL 4.6
- RECT-21 AT ROW 1.24 COL 2
- WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
- SIDE-LABELS NO-UNDERLINE THREE-D
- AT COL 1 ROW 1
- SIZE 126.4 BY 14.91.
- /* *********************** Procedure Settings ************************ */
- &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
- /* Settings for THIS-PROCEDURE
- Type: SmartFrame
- Allow: Basic,Browse,DB-Fields,Query,Smart
- Other Settings: PERSISTENT-ONLY COMPILE
- */
- /* This procedure should always be RUN PERSISTENT. Report the error, */
- /* then cleanup and return. */
- IF NOT THIS-PROCEDURE:PERSISTENT THEN DO:
- MESSAGE "{&FILE-NAME} should only be RUN PERSISTENT.":U
- VIEW-AS ALERT-BOX ERROR BUTTONS OK.
- RETURN.
- END.
- &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
- /* ************************* Create Window ************************** */
- &ANALYZE-SUSPEND _CREATE-WINDOW
- /* DESIGN Window definition (used by the UIB)
- CREATE WINDOW F-Frame-Win ASSIGN
- HEIGHT = 14.91
- WIDTH = 126.4.
- /* END WINDOW DEFINITION */
- */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB F-Frame-Win
- /* ************************* Included-Libraries *********************** */
- {src/adm/method/containr.i}
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- /* *********** Runtime Attributes and AppBuilder Settings *********** */
- &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
- /* SETTINGS FOR WINDOW F-Frame-Win
- VISIBLE,,RUN-PERSISTENT */
- /* SETTINGS FOR FRAME F-Main
- NOT-VISIBLE */
- /* BROWSE-TAB Br_Bonus_1 RECT-21 F-Main */
- /* SETTINGS FOR BUTTON Btn_Excel IN FRAME F-Main
- NO-ENABLE */
- /* _RUN-TIME-ATTRIBUTES-END */
- &ANALYZE-RESUME
- /* Setting information for Queries and Browse Widgets fields */
- &ANALYZE-SUSPEND _QUERY-BLOCK BROWSE Br_Bonus_1
- /* Query rebuild information for BROWSE Br_Bonus_1
- _TblList = "AnaDat.BonusAbr"
- _Where[1] = "BonusAbr.Firma = GVFirma
- AND BonusAbr.Bon_Sta = 1"
- _FldNameList[1] > AnaDat.BonusAbr.Knr
- "BonusAbr.Knr" ? "z999999" "integer" ? ? ? ? ? ? no ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no
- _FldNameList[2] > "_<CALC>"
- "VAdresse @ VAdresse" "Kunde" "x(30)" ? ? ? ? ? ? ? no ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no
- _FldNameList[3] > AnaDat.BonusAbr.VonDatum
- "BonusAbr.VonDatum" "Datum" ? "date" ? ? ? ? ? ? no ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no
- _FldNameList[4] > AnaDat.BonusAbr.Artnr
- "BonusAbr.Artnr" ? "z999999" "integer" ? ? ? ? ? ? no ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no
- _FldNameList[5] = AnaDat.BonusAbr.Inhalt
- _FldNameList[6] > AnaDat.BonusAbr.Jahr
- "BonusAbr.Jahr" ? "z9999" "integer" ? ? ? ? ? ? no ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no
- _FldNameList[7] > AnaDat.BonusAbr.Menge
- "BonusAbr.Menge" ? "z,zzz,zz9-" "decimal" ? ? ? ? ? ? no ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no
- _FldNameList[8] > AnaDat.BonusAbr.Volumen
- "BonusAbr.Volumen" ? "z,zzz,zz9-" "decimal" ? ? ? ? ? ? no ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no
- _FldNameList[9] > AnaDat.BonusAbr.Betrag
- "BonusAbr.Betrag" ? "z,zzz,zz9-" "decimal" ? ? ? ? ? ? no ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no
- _FldNameList[10] > AnaDat.BonusAbr.Bonus
- "BonusAbr.Bonus" ? "zz,zz9.99-" "decimal" ? ? ? ? ? ? no ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no
- _Query is OPENED
- */ /* BROWSE Br_Bonus_1 */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _QUERY-BLOCK FRAME F-Main
- /* Query rebuild information for FRAME F-Main
- _Options = ""
- _Query is NOT OPENED
- */ /* FRAME F-Main */
- &ANALYZE-RESUME
-
- /* ************************ Control Triggers ************************ */
- &Scoped-define SELF-NAME F-Main
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL F-Main F-Frame-Win
- ON END-ERROR OF FRAME F-Main
- DO:
- RUN new-state ( INPUT 'ENDE, MAIN':U ).
- RETURN NO-APPLY.
- END.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL F-Main F-Frame-Win
- ON GO OF FRAME F-Main
- DO:
- RUN new-state ( INPUT 'ENDE, MAIN':U ).
- RETURN NO-APPLY.
- END.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &Scoped-define BROWSE-NAME Br_Bonus_1
- &Scoped-define SELF-NAME Br_Bonus_1
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Br_Bonus_1 F-Frame-Win
- ON END-ERROR OF Br_Bonus_1 IN FRAME F-Main
- DO:
- RUN new-state ( INPUT 'ENDE, MAIN':U ).
- RETURN NO-APPLY.
- END.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Br_Bonus_1 F-Frame-Win
- ON ROW-DISPLAY OF Br_Bonus_1 IN FRAME F-Main
- DO:
- VAdresse = ''.
- IF NOT AVAILABLE BonusAbr THEN RETURN.
- FIND Adresse USE-INDEX Adresse-k1
- WHERE Adresse.Firma = AdFirma
- AND Adresse.Knr = BonusAbr.Knr NO-LOCK NO-ERROR.
- IF AVAILABLE Adresse THEN VAdresse = Adresse.Anzeig_Br.
- END.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &Scoped-define SELF-NAME Btn_Excel
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Excel F-Frame-Win
- ON CHOOSE OF Btn_Excel IN FRAME F-Main /* Excel */
- DO:
- DO WITH FRAME {&FRAME-NAME}:
- i1 = Br_Bonus_1:NUM-SELECTED-ROWS.
- IF i1 = 0 THEN RETURN NO-APPLY.
-
- Br_Bonus_1:FETCH-SELECTED-ROW(1).
-
- VVonDatum = BonusAbr.VonDatum.
- VBisDatum = BonusAbr.BisDatum.
- VKnr = BonusAbr.Knr.
- RUN CREATE_EXCEL ( INPUT 'ExcelVorlagen/BonusVorlage.xls', INPUT 'Bonus.xls', '' ).
-
- IF excelAppl = ? THEN RETURN NO-APPLY.
-
- FOR EACH TWork:
- DELETE TWork.
- END.
- i1 = 0.
- TiDruck = TRUE.
- VSeite = 0.
- VLine = 0.
- FOR EACH BBonusAbr USE-INDEX BonusAbr-k1
- WHERE BBonusAbr.Firma = GVFirma
- AND BBonusAbr.Bon_Sta = 0
- AND BBonusAbr.Knr = VKnr NO-LOCK,
- FIRST Artst OF BBonusAbr NO-LOCK
-
- BREAK BY BBonusAbr.Knr
- BY BBonusAbr.SummGrp
- BY Artst.Wg_Grp
- BY Artst.Prod_Grp
- BY Artst.Art_Grp
- BY Artst.Artnr
- BY Artst.Inhalt
- BY Artst.Jahr :
-
- IF FIRST-OF ( BBonusAbr.Knr ) THEN DO:
- FIND Adresse USE-INDEX Adresse-k1
- WHERE Adresse.Firma = AdFirma
- AND Adresse.Knr = BBonusAbr.Knr NO-LOCK NO-ERROR.
- VAnschrift = ''.
- IF AVAILABLE Adresse THEN DO:
- DO ix = 1 TO 12:
- VAnschrift[ix] = Adresse.Anschrift[ix].
- END.
- END.
- TiDruck = TRUE.
- END.
-
- i1 = (VLine - (VLine MOD 40)) / 40.
- IF i1 > (VSeite - 1) THEN TiDruck = TRUE.
-
- DO WHILE TiDruck:
- RUN TITEL.
- TiDruck = FALSE.
- END.
- IF FIRST-OF ( BBonusAbr.SummGrp ) THEN DO:
- FIND FIRST BonSumm USE-INDEX BonSumm-k1
- WHERE BonSumm.Firma = GVFirma
- AND BonSumm.Bon_Summ = BBonusAbr.SummGrp NO-LOCK.
- VZelle = 'A' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = BonSumm.Bez.
- excelAppl:ActiveCell:Font:Bold = TRUE.
- VLine = VLine + 1.
- IF BBonusAbr.Bon_Art = 1 THEN VRabatt = STRING(BBonusAbr.Bon_Wert,"z9.99-%").
- ELSE VRabatt = STRING(BBonusAbr.Bon_Wert,"z9.99-Fr.").
- END.
-
- IF FIRST-OF ( Artst.Wg_Grp ) THEN DO:
- FIND WarenGrp USE-INDEX WarenGrp-k1
- WHERE WarenGrp.Firma = GVFirma
- AND WarenGrp.Wgr = Artst.Wg_Grp NO-LOCK.
- VZelle = 'B' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = WarenGrp.Bez1.
- excelAppl:ActiveCell:Font:Bold = TRUE.
- VLine = VLine + 1.
- END.
-
- FIND KGebinde USE-INDEX KGebinde-k1
- WHERE KGebinde.Firma = Artst.Firma
- AND KGebinde.Geb_Cd = Artst.KGeb_Cd NO-LOCK NO-ERROR.
-
- VZelle = 'A' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = STRING(Artst.Artnr ,"999999")
- + "."
- + STRING(Artst.Inhalt ,"9999").
-
- VZelle = 'B' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = Artst.Bez.
- IF Artst.Jahr > 1900 THEN DO:
- VZelle = 'C' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = STRING(Artst.Jahr ,"9999").
- END.
-
- IF Artst.Alk_Gehalt > 0 THEN DO:
- VZelle = 'D' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = STRING(Artst.Alk_Gehalt,"z9.99%").
- END.
-
- VZelle = 'E' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = KGebinde.KBez.
-
- VZelle = 'F' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = STRING(BBonusAbr.Menge ,"->>>>>>>>9").
-
- VZelle = 'G' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = STRING(BBonusAbr.Volumen ,"->>>>>>>>9").
-
- VZelle = 'H' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = STRING(BBonusAbr.Betrag ,"->>>>>>>>9").
-
- VZelle = 'I' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = VRabatt.
- VZelle = 'J' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = STRING(BBonusAbr.Bonus ,"->>>>9.99").
-
- VLine = VLine + 1.
-
- FIND TWork USE-INDEX TWork-k1
- WHERE TWork.SummGrp = BBonusAbr.SummGrp
- AND TWork.MWST% = BBonusAbr.MWST-% NO-ERROR.
- IF NOT AVAILABLE TWork THEN DO:
- CREATE TWork.
- ASSIGN TWork.SummGrp = BBonusAbr.SummGrp
- TWork.MWST% = BBonusAbr.MWST-%.
- END.
- TWork.Menge = TWork.Menge + BBonusAbr.Menge.
- TWork.Liter = TWork.Liter + BBonusAbr.Volumen.
- TWork.Betrag = TWork.Betrag + BBonusAbr.Betrag.
- TWork.Bonus = TWork.Bonus + BBonusAbr.Bonus.
-
- IF NOT LAST-OF ( BBonusAbr.SummGrp ) THEN NEXT.
-
- VTotal = 0.
- FOR EACH TWork WHERE TWork.SummGrp = BBonusAbr.SummGrp NO-LOCK:
- VTotal[01] = VTotal[01] + TWork.Menge.
- VTotal[02] = VTotal[02] + TWork.Liter.
- VTotal[03] = VTotal[03] + TWork.Betrag.
- VTotal[04] = VTotal[04] + TWork.Bonus.
- END.
-
- VLine = VLine + 1.
- VZelle = 'F' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = STRING(VTotal[01],"->>>>>>>>9").
-
- VZelle = 'G' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = STRING(VTotal[02],"->>>>>>>>9").
-
- VZelle = 'H' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = STRING(VTotal[03],"->>>>>>>>9").
-
- VZelle = 'J' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = STRING(VTotal[04],"->>>>9.99").
- VZelle = 'F' + STRING(VLine) + ":J" + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:Font:Bold = TRUE.
- excelAppl:Rows(VLine):Select.
- excelAppl:Selection:Font:Bold = TRUE.
- VLine = VLine + 1.
- END.
- VTotal = 0.
- Zuszz = 3.
- FOR EACH TWork NO-LOCK
- BREAK BY TWork.MWST%:
- VTotal[06] = VTotal[06] + TWork.Menge.
- VTotal[07] = VTotal[07] + TWork.Liter.
- VTotal[08] = VTotal[08] + TWork.Betrag.
- VTotal[09] = VTotal[09] + TWork.Bonus.
- IF FIRST-OF ( TWork.MWST% ) THEN Zuszz = Zuszz + 1.
- END.
-
- i1 = (VLine + Zuszz - (VLine MOD 40)) / 40.
- IF i1 > (VSeite - 1) THEN DO:
- TiDruck = TRUE.
- RUN TITEL.
- TiDruck = FALSE.
- END.
- ELSE VLine = VLine + 1.
- VZelle = 'B' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = 'Total Bonusbetrag'.
-
- VZelle = 'J' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = STRING(VTotal[09],"->>>>9.99").
- excelAppl:Rows(VLine):Select.
- excelAppl:Selection:Font:Bold = TRUE.
- VLine = VLine + 1.
- VBuchen = 0.
- VAnsatz = 0.
- i5 = 0.
- FOR EACH TWork
- BREAK BY TWork.MWST%:
- VTotal[01] = VTotal[01] + TWork.Menge.
- VTotal[02] = VTotal[02] + TWork.Liter.
- VTotal[03] = VTotal[03] + TWork.Betrag.
- VTotal[04] = VTotal[04] + TWork.Bonus.
- IF NOT LAST-OF ( TWork.MWST% ) THEN NEXT.
- Rundbetr = VTotal[04] * TWork.MWST% / 100.
- VTotal[09] = VTotal[09] + Rundbetr.
-
- i5 = i5 + 1.
- VBuchen[i5] = VTotal[04].
- VAnsatz[i5] = TWork.MWST%.
-
- VZelle = 'E' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = 'MWST ' + STRING(TWork.MWST%,"z9.99%").
- VZelle = 'H' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = STRING(VTotal[04],"->>>>>>>>9").
- VZelle = 'J' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = STRING(Rundbetr ,"->>>>9.99").
-
- VLine = VLine + 1.
- VTotal[01] = 0.
- VTotal[02] = 0.
- VTotal[03] = 0.
- VTotal[04] = 0.
- VTotal[05] = 0.
- END.
- Rundbetr = VTotal[09].
- Rundcode = 1.
- RUN "v8/runden.p".
- VTotal[09] = Rundbetr.
-
- VZelle = 'B' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = 'Bonusgutschrift inklusive Mehrwertsteuer'.
-
- VZelle = 'J' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell:FormulaR1C1 = STRING(VTotal[09],"->>>>9.99").
- excelAppl:Rows(VLine):Select.
- excelAppl:Selection:Font:Bold = TRUE.
- VLine = VLine + 1.
- excelAppl:Application:Run('SeitenWechsel').
- /*
- excelAppl:Visible = FALSE.
- */
- LVKnr = BonusAbr.Knr.
- LVRecid = RECID(BonusAbr).
- RUN "v8/d-bonusbuchen.w".
- /*
- excelAppl:Visible = TRUE.
- */
- RELEASE OBJECT excelAppl.
-
- RUN OPEN_BonusAbr.
- END.
-
- END.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &UNDEFINE SELF-NAME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK F-Frame-Win
- /* *************************** Main Block *************************** */
- SUBSCRIBE TO 'BONUSLAGER' ANYWHERE.
- &IF DEFINED(UIB_IS_RUNNING) <> 0 &THEN
- /* Now enable the interface if in test mode - otherwise this happens when
- the object is explicitly initialized from its container. */
- RUN dispatch IN THIS-PROCEDURE ('initialize':U).
- &ENDIF
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- /* ********************** Internal Procedures *********************** */
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-create-objects F-Frame-Win _ADM-CREATE-OBJECTS
- PROCEDURE adm-create-objects :
- /*------------------------------------------------------------------------------
- Purpose: Create handles for all SmartObjects used in this procedure.
- After SmartObjects are initialized, then SmartLinks are added.
- Parameters: <none>
- ------------------------------------------------------------------------------*/
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-row-available F-Frame-Win _ADM-ROW-AVAILABLE
- PROCEDURE adm-row-available :
- /*------------------------------------------------------------------------------
- Purpose: Dispatched to this procedure when the Record-
- Source has a new row available. This procedure
- tries to get the new row (or foriegn keys) from
- the Record-Source and process it.
- Parameters: <none>
- ------------------------------------------------------------------------------*/
- /* Define variables needed by this internal procedure. */
- {src/adm/template/row-head.i}
- /* Process the newly available records (i.e. display fields,
- open queries, and/or pass records on to any RECORD-TARGETS). */
- {src/adm/template/row-end.i}
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BONUSLAGER F-Frame-Win
- PROCEDURE BONUSLAGER :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DEF INPUT PARAMETER ipLager AS INT NO-UNDO.
- iLager = ipLager.
-
- DO WITH FRAME {&FRAME-NAME}:
- APPLY 'ENTRY' TO BROWSE {&BROWSE-NAME}.
- RETURN NO-APPLY.
- END.
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE CREATE_EXCEL F-Frame-Win
- PROCEDURE CREATE_EXCEL :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DEF INPUT PARAMETER VVorlage AS CHAR NO-UNDO.
- DEF INPUT PARAMETER VDatei AS CHAR NO-UNDO.
- DEF INPUT PARAMETER VMakro AS CHAR NO-UNDO.
- DEF VAR MyFile AS CHAR NO-UNDO.
- DEF VAR VWert AS CHAR NO-UNDO.
- DO WHILE TRUE:
- GET-KEY-VALUE SECTION 'Einstellungen'
- KEY 'InstallPfad'
- VALUE VWert.
- IF VWert = ? OR
- VWert = '' THEN DO:
- FILE-INFO:FILE-NAME = 'Ge_MIS.ini'.
- VWert = REPLACE(FILE-INFO:FULL-PATHNAME, FILE-INFO:FILE-NAME, '').
- VWert = SUBSTRIN(VWert,01,LENGTH(VWert) - 1).
- END.
- IF INDEX(PROPATH, VWert) = 0 THEN DO:
- PROPATH = VWert + "," + PROPATH.
- END.
-
- excelAppl = ?.
- MyFile = SEARCH(VVorlage).
- IF MyFile = ? THEN DO:
- MESSAGE 'Vorlage ' VVorlage ' nicht gefunden' VIEW-AS ALERT-BOX.
- RETURN.
- END.
-
- DO WHILE TRUE TRANSACTION:
- FIND Tabel USE-INDEX Tabel-k1
- WHERE Tabel.Firma = GVFirma
- AND Tabel.RecArt = 'TEMPFILE'
- AND Tabel.CodeI = 0
- AND Tabel.CodeC = 'EXCEL'
- AND Tabel.Sprcd = 1 NO-ERROR.
- IF NOT AVAILABLE Tabel THEN DO:
- CREATE Tabel.
- ASSIGN Tabel.Firma = GVFirma
- Tabel.RecArt = 'TEMPFILE'
- Tabel.CodeI = 0
- Tabel.CodeC = 'EXCEL'
- Tabel.Sprcd = 1
- Tabel.Bez1 = SESSION:TEMP-DIR.
- END.
- Tabel.Int_1 = Tabel.Int_1 + 1.
- IF VDatei = '' THEN VDatei = Tabel.Bez1 + STRING(Tabel.Int_1) + '.tmp'.
- ELSE VDatei = Tabel.Bez1 + VDatei.
- RELEASE Tabel.
- LEAVE.
- END.
-
- OS-COPY VALUE(MyFile) VALUE(VDatei).
-
- CREATE 'Excel.Application' excelAppl.
-
- excelAppl:Visible = TRUE.
- excelAppl:Workbooks:Open(VDatei, True).
-
- LEAVE.
- END.
- RETURN.
- /*
- excelAppl:Application:Run('Bestell').
- */
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI F-Frame-Win _DEFAULT-DISABLE
- PROCEDURE disable_UI :
- /*------------------------------------------------------------------------------
- Purpose: DISABLE the User Interface
- Parameters: <none>
- Notes: Here we clean-up the user-interface by deleting
- dynamic widgets we have created and/or hide
- frames. This procedure is usually called when
- we are ready to "clean-up" after running.
- ------------------------------------------------------------------------------*/
- /* Hide all frames. */
- HIDE FRAME F-Main.
- IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI F-Frame-Win _DEFAULT-ENABLE
- PROCEDURE enable_UI :
- /*------------------------------------------------------------------------------
- Purpose: ENABLE the User Interface
- Parameters: <none>
- Notes: Here we display/view/enable the widgets in the
- user-interface. In addition, OPEN all queries
- associated with each FRAME and BROWSE.
- These statements here are based on the "Other
- Settings" section of the widget Property Sheets.
- ------------------------------------------------------------------------------*/
- ENABLE RECT-21 Br_Bonus_1
- WITH FRAME F-Main.
- {&OPEN-BROWSERS-IN-QUERY-F-Main}
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE local-view F-Frame-Win
- PROCEDURE local-view :
- /*------------------------------------------------------------------------------
- Purpose: Override standard ADM method
- Notes:
- ------------------------------------------------------------------------------*/
- RUN dispatch IN THIS-PROCEDURE ( INPUT 'view':U ) .
- RUN OPEN_BonusAbr.
-
- PUBLISH 'GETBONUSLAGER' ( OUTPUT iLager ).
-
- APPLY 'ENTRY' TO BROWSE Br_Bonus_1.
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE OPEN_BonusAbr F-Frame-Win
- PROCEDURE OPEN_BonusAbr :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DO WITH FRAME {&FRAME-NAME}:
- IF NUM-RESULTS("{&BROWSE-NAME}":U) <> ? THEN CLOSE QUERY Br_Bonus_1.
-
- OPEN QUERY Br_Bonus_1
- FOR EACH BonusAbr USE-INDEX BonusAbr-k1
- WHERE BonusAbr.Firma = GVFirma
- AND BonusAbr.Bon_Sta = 1 NO-LOCK.
-
- END.
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE send-records F-Frame-Win _ADM-SEND-RECORDS
- PROCEDURE send-records :
- /*------------------------------------------------------------------------------
- Purpose: Send record ROWID's for all tables used by
- this file.
- Parameters: see template/snd-head.i
- ------------------------------------------------------------------------------*/
- /* Define variables needed by this internal procedure. */
- {src/adm/template/snd-head.i}
- /* For each requested table, put it's ROWID in the output list. */
- {src/adm/template/snd-list.i "BonusAbr"}
- /* Deal with any unexpected table requests before closing. */
- {src/adm/template/snd-end.i}
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE state-changed F-Frame-Win
- PROCEDURE state-changed :
- /* -----------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- -------------------------------------------------------------*/
- DEFINE INPUT PARAMETER p-issuer-hdl AS HANDLE NO-UNDO.
- DEFINE INPUT PARAMETER p-state AS CHARACTER NO-UNDO.
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE TEMP_FILE F-Frame-Win
- PROCEDURE TEMP_FILE :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DO WHILE TRUE TRANSACTION:
- FIND Tabel USE-INDEX Tabel-k1
- WHERE Tabel.Firma = GVFirma
- AND Tabel.RecArt = 'TEMPFILE'
- AND Tabel.CodeI = 0
- AND Tabel.CodeC = 'EXCEL'
- AND Tabel.Sprcd = 1 NO-ERROR.
- IF NOT AVAILABLE Tabel THEN DO:
- CREATE Tabel.
- ASSIGN Tabel.Firma = GVFirma
- Tabel.RecArt = 'TEMPFILE'
- Tabel.CodeI = 0
- Tabel.CodeC = 'EXCEL'
- Tabel.Sprcd = 1
- Tabel.Bez1 = SESSION:TEMP-DIR.
- END.
- Tabel.Int_1 = Tabel.Int_1 + 1.
- VTemp = Tabel.Bez1 + 'Ge_MIS' + STRING(Tabel.Int_1) + '.tmp'.
- RELEASE Tabel.
- LEAVE.
- END.
-
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE TITEL F-Frame-Win
- PROCEDURE TITEL :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- IF VSeite > 0 THEN DO:
- IF (VSeite * 40) < VLine THEN VLine = VSeite * 40.
- VLine = VLine + 1.
- VZelle = 'A' + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:Selection:VALUE = "&SW&".
- END.
- VSeite = VSeite + 1.
- VLine = VLine + 1.
- DO ix = 3 TO 9:
- VZelle = 'A' + TRIM(STRING(VLine)).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell = TRIM(VAnschrift[ix]).
- IF ix = 8 THEN DO:
- excelAppl:ActiveCell:Font:Bold = TRUE.
- END.
- VLine = VLine + 1.
- END.
- VZelle = 'C' + STRING(VLine - 3).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveCell = 'Bonusabrechnung '
- + STRING(BBonusAbr.VonDatum,"99.99.9999")
- + " - "
- + STRING(BBonusAbr.BisDatum,"99.99.9999").
- excelAppl:ActiveCell:Font:Bold = TRUE.
- excelAppl:ActiveCell:Font:Size = 12.
- VLine = ((VSeite - 1) * 40) + 9.
- IF VSeite > 1 THEN DO:
- excelAppl:Range("A9:J9"):Select.
- excelAppl:Selection:Copy.
- VZelle = 'A' + STRING(VLine) + ":J" + STRING(VLine).
- excelAppl:Range(VZelle):Select.
- excelAppl:ActiveSheet:Paste.
- END.
- VLine = VLine + 1.
-
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
|