f-bonverbuchte.w 33 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984
  1. &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v8r12 GUI ADM1
  2. &ANALYZE-RESUME
  3. /* Connected Databases
  4. anadat PROGRESS
  5. */
  6. &Scoped-define WINDOW-NAME CURRENT-WINDOW
  7. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS F-Frame-Win
  8. /*------------------------------------------------------------------------
  9. File:
  10. Description: from cntnrfrm.w - ADM SmartFrame Template
  11. Input Parameters:
  12. <none>
  13. Output Parameters:
  14. <none>
  15. ------------------------------------------------------------------------*/
  16. /* This .W file was created with the Progress UIB. */
  17. /*----------------------------------------------------------------------*/
  18. /* Create an unnamed pool to store all the widgets created
  19. by this procedure. This is a good default which assures
  20. that this procedure's triggers and internal procedures
  21. will execute in this procedure's storage, and that proper
  22. cleanup will occur on deletion of the procedure. */
  23. CREATE WIDGET-POOL.
  24. /* *************************** Definitions ************************** */
  25. /* Parameters Definitions --- */
  26. /* Local Variable Definitions --- */
  27. DEF VAR VVonDatum AS DATE FORMAT "99.99.9999" NO-UNDO.
  28. DEF VAR VBisDatum AS DATE FORMAT "99.99.9999" NO-UNDO.
  29. DEF VAR VKnr AS INT NO-UNDO.
  30. DEF VAR VAnschrift LIKE Adresse.Anschrift NO-UNDO.
  31. DEF VAR VZelle AS CHAR NO-UNDO.
  32. DEF VAR VTotal AS DEC EXTENT 10 NO-UNDO.
  33. DEF VAR VRabatt AS CHAR NO-UNDO.
  34. DEF VAR VTemp AS CHAR NO-UNDO.
  35. DEF VAR VAdresse AS CHAR FORMAT "x(10)" NO-UNDO.
  36. DEF VAR iLager AS INT NO-UNDO.
  37. DEF VAR excelAppl AS COM-HANDLE NO-UNDO.
  38. DEF TEMP-TABLE TWork FIELD SummGrp AS INT
  39. FIELD MWST% AS DEC
  40. FIELD Menge AS DEC
  41. FIELD Liter AS DEC
  42. FIELD Betrag AS DEC
  43. FIELD Bonus AS DEC
  44. INDEX TWork-k1 IS UNIQUE PRIMARY
  45. SummGrp
  46. MWST%.
  47. DEF BUFFER BBonusAbr FOR BonusAbr.
  48. DEF NEW SHARED VAR VBuchen AS DEC EXTENT 10.
  49. DEF NEW SHARED VAR VAnsatz AS DEC EXTENT 10.
  50. /* ---------- Globale Variablen ---------------------------------- */
  51. { v8/globvar.i" " " " "SHARED" }
  52. { v8/debivar.i " " " " "SHARED" }
  53. { v8/artivar.i " " " " "SHARED" }
  54. { v8/contvar.i " " " " "SHARED" }
  55. { v8/listtitv.i "NEW" "SHARED" }
  56. /* _UIB-CODE-BLOCK-END */
  57. &ANALYZE-RESUME
  58. &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  59. /* ******************** Preprocessor Definitions ******************** */
  60. &Scoped-define PROCEDURE-TYPE SmartFrame
  61. &Scoped-define DB-AWARE no
  62. &Scoped-define ADM-CONTAINER FRAME
  63. /* Name of first Frame and/or Browse and/or first Query */
  64. &Scoped-define FRAME-NAME F-Main
  65. &Scoped-define BROWSE-NAME Br_Bonus_1
  66. /* Internal Tables (found by Frame, Query & Browse Queries) */
  67. &Scoped-define INTERNAL-TABLES BonusAbr
  68. /* Definitions for BROWSE Br_Bonus_1 */
  69. &Scoped-define FIELDS-IN-QUERY-Br_Bonus_1 BonusAbr.Knr VAdresse @ VAdresse ~
  70. BonusAbr.VonDatum BonusAbr.Artnr BonusAbr.Inhalt BonusAbr.Jahr ~
  71. BonusAbr.Menge BonusAbr.Volumen BonusAbr.Betrag BonusAbr.Bonus
  72. &Scoped-define ENABLED-FIELDS-IN-QUERY-Br_Bonus_1
  73. &Scoped-define QUERY-STRING-Br_Bonus_1 FOR EACH BonusAbr ~
  74. WHERE BonusAbr.Firma = GVFirma ~
  75. AND BonusAbr.Bon_Sta = 1 NO-LOCK
  76. &Scoped-define OPEN-QUERY-Br_Bonus_1 OPEN QUERY Br_Bonus_1 FOR EACH BonusAbr ~
  77. WHERE BonusAbr.Firma = GVFirma ~
  78. AND BonusAbr.Bon_Sta = 1 NO-LOCK.
  79. &Scoped-define TABLES-IN-QUERY-Br_Bonus_1 BonusAbr
  80. &Scoped-define FIRST-TABLE-IN-QUERY-Br_Bonus_1 BonusAbr
  81. /* Definitions for FRAME F-Main */
  82. &Scoped-define OPEN-BROWSERS-IN-QUERY-F-Main ~
  83. ~{&OPEN-QUERY-Br_Bonus_1}
  84. /* Standard List Definitions */
  85. &Scoped-Define ENABLED-OBJECTS RECT-21 Br_Bonus_1
  86. /* Custom List Definitions */
  87. /* List-1,List-2,List-3,List-4,List-5,List-6 */
  88. /* _UIB-PREPROCESSOR-BLOCK-END */
  89. &ANALYZE-RESUME
  90. /* *********************** Control Definitions ********************** */
  91. /* Definitions of the field level widgets */
  92. DEFINE BUTTON Btn_Excel
  93. LABEL "&Excel"
  94. SIZE 14 BY 1.24.
  95. DEFINE RECTANGLE RECT-21
  96. EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL
  97. SIZE 123.8 BY 14.24.
  98. /* Query definitions */
  99. &ANALYZE-SUSPEND
  100. DEFINE QUERY Br_Bonus_1 FOR
  101. BonusAbr SCROLLING.
  102. &ANALYZE-RESUME
  103. /* Browse definitions */
  104. DEFINE BROWSE Br_Bonus_1
  105. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _DISPLAY-FIELDS Br_Bonus_1 F-Frame-Win _STRUCTURED
  106. QUERY Br_Bonus_1 DISPLAY
  107. BonusAbr.Knr FORMAT "z999999":U
  108. VAdresse @ VAdresse COLUMN-LABEL "Kunde" FORMAT "x(30)":U
  109. BonusAbr.VonDatum COLUMN-LABEL "Datum" FORMAT "99.99.9999":U
  110. BonusAbr.Artnr FORMAT "z999999":U
  111. BonusAbr.Inhalt FORMAT "9999":U
  112. BonusAbr.Jahr FORMAT "z9999":U
  113. BonusAbr.Menge FORMAT "z,zzz,zz9-":U
  114. BonusAbr.Volumen FORMAT "z,zzz,zz9-":U
  115. BonusAbr.Betrag FORMAT "z,zzz,zz9-":U
  116. BonusAbr.Bonus FORMAT "zz,zz9.99-":U
  117. /* _UIB-CODE-BLOCK-END */
  118. &ANALYZE-RESUME
  119. WITH NO-ROW-MARKERS SEPARATORS SIZE 122 BY 10.95
  120. BGCOLOR 15 .
  121. /* ************************ Frame Definitions *********************** */
  122. DEFINE FRAME F-Main
  123. Br_Bonus_1 AT ROW 1.48 COL 3
  124. Btn_Excel AT ROW 13.38 COL 4.6
  125. RECT-21 AT ROW 1.24 COL 2
  126. WITH 1 DOWN NO-BOX KEEP-TAB-ORDER OVERLAY
  127. SIDE-LABELS NO-UNDERLINE THREE-D
  128. AT COL 1 ROW 1
  129. SIZE 126.4 BY 14.91.
  130. /* *********************** Procedure Settings ************************ */
  131. &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  132. /* Settings for THIS-PROCEDURE
  133. Type: SmartFrame
  134. Allow: Basic,Browse,DB-Fields,Query,Smart
  135. Other Settings: PERSISTENT-ONLY COMPILE
  136. */
  137. /* This procedure should always be RUN PERSISTENT. Report the error, */
  138. /* then cleanup and return. */
  139. IF NOT THIS-PROCEDURE:PERSISTENT THEN DO:
  140. MESSAGE "{&FILE-NAME} should only be RUN PERSISTENT.":U
  141. VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  142. RETURN.
  143. END.
  144. &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  145. /* ************************* Create Window ************************** */
  146. &ANALYZE-SUSPEND _CREATE-WINDOW
  147. /* DESIGN Window definition (used by the UIB)
  148. CREATE WINDOW F-Frame-Win ASSIGN
  149. HEIGHT = 14.91
  150. WIDTH = 126.4.
  151. /* END WINDOW DEFINITION */
  152. */
  153. &ANALYZE-RESUME
  154. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _INCLUDED-LIB F-Frame-Win
  155. /* ************************* Included-Libraries *********************** */
  156. {src/adm/method/containr.i}
  157. /* _UIB-CODE-BLOCK-END */
  158. &ANALYZE-RESUME
  159. /* *********** Runtime Attributes and AppBuilder Settings *********** */
  160. &ANALYZE-SUSPEND _RUN-TIME-ATTRIBUTES
  161. /* SETTINGS FOR WINDOW F-Frame-Win
  162. VISIBLE,,RUN-PERSISTENT */
  163. /* SETTINGS FOR FRAME F-Main
  164. NOT-VISIBLE */
  165. /* BROWSE-TAB Br_Bonus_1 RECT-21 F-Main */
  166. /* SETTINGS FOR BUTTON Btn_Excel IN FRAME F-Main
  167. NO-ENABLE */
  168. /* _RUN-TIME-ATTRIBUTES-END */
  169. &ANALYZE-RESUME
  170. /* Setting information for Queries and Browse Widgets fields */
  171. &ANALYZE-SUSPEND _QUERY-BLOCK BROWSE Br_Bonus_1
  172. /* Query rebuild information for BROWSE Br_Bonus_1
  173. _TblList = "AnaDat.BonusAbr"
  174. _Where[1] = "BonusAbr.Firma = GVFirma
  175. AND BonusAbr.Bon_Sta = 1"
  176. _FldNameList[1] > AnaDat.BonusAbr.Knr
  177. "BonusAbr.Knr" ? "z999999" "integer" ? ? ? ? ? ? no ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no
  178. _FldNameList[2] > "_<CALC>"
  179. "VAdresse @ VAdresse" "Kunde" "x(30)" ? ? ? ? ? ? ? no ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no
  180. _FldNameList[3] > AnaDat.BonusAbr.VonDatum
  181. "BonusAbr.VonDatum" "Datum" ? "date" ? ? ? ? ? ? no ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no
  182. _FldNameList[4] > AnaDat.BonusAbr.Artnr
  183. "BonusAbr.Artnr" ? "z999999" "integer" ? ? ? ? ? ? no ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no
  184. _FldNameList[5] = AnaDat.BonusAbr.Inhalt
  185. _FldNameList[6] > AnaDat.BonusAbr.Jahr
  186. "BonusAbr.Jahr" ? "z9999" "integer" ? ? ? ? ? ? no ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no
  187. _FldNameList[7] > AnaDat.BonusAbr.Menge
  188. "BonusAbr.Menge" ? "z,zzz,zz9-" "decimal" ? ? ? ? ? ? no ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no
  189. _FldNameList[8] > AnaDat.BonusAbr.Volumen
  190. "BonusAbr.Volumen" ? "z,zzz,zz9-" "decimal" ? ? ? ? ? ? no ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no
  191. _FldNameList[9] > AnaDat.BonusAbr.Betrag
  192. "BonusAbr.Betrag" ? "z,zzz,zz9-" "decimal" ? ? ? ? ? ? no ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no
  193. _FldNameList[10] > AnaDat.BonusAbr.Bonus
  194. "BonusAbr.Bonus" ? "zz,zz9.99-" "decimal" ? ? ? ? ? ? no ? no no ? yes no no "U" "" "" "" "" "" "" 0 no 0 no no
  195. _Query is OPENED
  196. */ /* BROWSE Br_Bonus_1 */
  197. &ANALYZE-RESUME
  198. &ANALYZE-SUSPEND _QUERY-BLOCK FRAME F-Main
  199. /* Query rebuild information for FRAME F-Main
  200. _Options = ""
  201. _Query is NOT OPENED
  202. */ /* FRAME F-Main */
  203. &ANALYZE-RESUME
  204. /* ************************ Control Triggers ************************ */
  205. &Scoped-define SELF-NAME F-Main
  206. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL F-Main F-Frame-Win
  207. ON END-ERROR OF FRAME F-Main
  208. DO:
  209. RUN new-state ( INPUT 'ENDE, MAIN':U ).
  210. RETURN NO-APPLY.
  211. END.
  212. /* _UIB-CODE-BLOCK-END */
  213. &ANALYZE-RESUME
  214. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL F-Main F-Frame-Win
  215. ON GO OF FRAME F-Main
  216. DO:
  217. RUN new-state ( INPUT 'ENDE, MAIN':U ).
  218. RETURN NO-APPLY.
  219. END.
  220. /* _UIB-CODE-BLOCK-END */
  221. &ANALYZE-RESUME
  222. &Scoped-define BROWSE-NAME Br_Bonus_1
  223. &Scoped-define SELF-NAME Br_Bonus_1
  224. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Br_Bonus_1 F-Frame-Win
  225. ON END-ERROR OF Br_Bonus_1 IN FRAME F-Main
  226. DO:
  227. RUN new-state ( INPUT 'ENDE, MAIN':U ).
  228. RETURN NO-APPLY.
  229. END.
  230. /* _UIB-CODE-BLOCK-END */
  231. &ANALYZE-RESUME
  232. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Br_Bonus_1 F-Frame-Win
  233. ON ROW-DISPLAY OF Br_Bonus_1 IN FRAME F-Main
  234. DO:
  235. VAdresse = ''.
  236. IF NOT AVAILABLE BonusAbr THEN RETURN.
  237. FIND Adresse USE-INDEX Adresse-k1
  238. WHERE Adresse.Firma = AdFirma
  239. AND Adresse.Knr = BonusAbr.Knr NO-LOCK NO-ERROR.
  240. IF AVAILABLE Adresse THEN VAdresse = Adresse.Anzeig_Br.
  241. END.
  242. /* _UIB-CODE-BLOCK-END */
  243. &ANALYZE-RESUME
  244. &Scoped-define SELF-NAME Btn_Excel
  245. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CONTROL Btn_Excel F-Frame-Win
  246. ON CHOOSE OF Btn_Excel IN FRAME F-Main /* Excel */
  247. DO:
  248. DO WITH FRAME {&FRAME-NAME}:
  249. i1 = Br_Bonus_1:NUM-SELECTED-ROWS.
  250. IF i1 = 0 THEN RETURN NO-APPLY.
  251. Br_Bonus_1:FETCH-SELECTED-ROW(1).
  252. VVonDatum = BonusAbr.VonDatum.
  253. VBisDatum = BonusAbr.BisDatum.
  254. VKnr = BonusAbr.Knr.
  255. RUN CREATE_EXCEL ( INPUT 'ExcelVorlagen/BonusVorlage.xls', INPUT 'Bonus.xls', '' ).
  256. IF excelAppl = ? THEN RETURN NO-APPLY.
  257. FOR EACH TWork:
  258. DELETE TWork.
  259. END.
  260. i1 = 0.
  261. TiDruck = TRUE.
  262. VSeite = 0.
  263. VLine = 0.
  264. FOR EACH BBonusAbr USE-INDEX BonusAbr-k1
  265. WHERE BBonusAbr.Firma = GVFirma
  266. AND BBonusAbr.Bon_Sta = 0
  267. AND BBonusAbr.Knr = VKnr NO-LOCK,
  268. FIRST Artst OF BBonusAbr NO-LOCK
  269. BREAK BY BBonusAbr.Knr
  270. BY BBonusAbr.SummGrp
  271. BY Artst.Wg_Grp
  272. BY Artst.Prod_Grp
  273. BY Artst.Art_Grp
  274. BY Artst.Artnr
  275. BY Artst.Inhalt
  276. BY Artst.Jahr :
  277. IF FIRST-OF ( BBonusAbr.Knr ) THEN DO:
  278. FIND Adresse USE-INDEX Adresse-k1
  279. WHERE Adresse.Firma = AdFirma
  280. AND Adresse.Knr = BBonusAbr.Knr NO-LOCK NO-ERROR.
  281. VAnschrift = ''.
  282. IF AVAILABLE Adresse THEN DO:
  283. DO ix = 1 TO 12:
  284. VAnschrift[ix] = Adresse.Anschrift[ix].
  285. END.
  286. END.
  287. TiDruck = TRUE.
  288. END.
  289. i1 = (VLine - (VLine MOD 40)) / 40.
  290. IF i1 > (VSeite - 1) THEN TiDruck = TRUE.
  291. DO WHILE TiDruck:
  292. RUN TITEL.
  293. TiDruck = FALSE.
  294. END.
  295. IF FIRST-OF ( BBonusAbr.SummGrp ) THEN DO:
  296. FIND FIRST BonSumm USE-INDEX BonSumm-k1
  297. WHERE BonSumm.Firma = GVFirma
  298. AND BonSumm.Bon_Summ = BBonusAbr.SummGrp NO-LOCK.
  299. VZelle = 'A' + STRING(VLine).
  300. excelAppl:Range(VZelle):Select.
  301. excelAppl:ActiveCell:FormulaR1C1 = BonSumm.Bez.
  302. excelAppl:ActiveCell:Font:Bold = TRUE.
  303. VLine = VLine + 1.
  304. IF BBonusAbr.Bon_Art = 1 THEN VRabatt = STRING(BBonusAbr.Bon_Wert,"z9.99-%").
  305. ELSE VRabatt = STRING(BBonusAbr.Bon_Wert,"z9.99-Fr.").
  306. END.
  307. IF FIRST-OF ( Artst.Wg_Grp ) THEN DO:
  308. FIND WarenGrp USE-INDEX WarenGrp-k1
  309. WHERE WarenGrp.Firma = GVFirma
  310. AND WarenGrp.Wgr = Artst.Wg_Grp NO-LOCK.
  311. VZelle = 'B' + STRING(VLine).
  312. excelAppl:Range(VZelle):Select.
  313. excelAppl:ActiveCell:FormulaR1C1 = WarenGrp.Bez1.
  314. excelAppl:ActiveCell:Font:Bold = TRUE.
  315. VLine = VLine + 1.
  316. END.
  317. FIND KGebinde USE-INDEX KGebinde-k1
  318. WHERE KGebinde.Firma = Artst.Firma
  319. AND KGebinde.Geb_Cd = Artst.KGeb_Cd NO-LOCK NO-ERROR.
  320. VZelle = 'A' + STRING(VLine).
  321. excelAppl:Range(VZelle):Select.
  322. excelAppl:ActiveCell:FormulaR1C1 = STRING(Artst.Artnr ,"999999")
  323. + "."
  324. + STRING(Artst.Inhalt ,"9999").
  325. VZelle = 'B' + STRING(VLine).
  326. excelAppl:Range(VZelle):Select.
  327. excelAppl:ActiveCell:FormulaR1C1 = Artst.Bez.
  328. IF Artst.Jahr > 1900 THEN DO:
  329. VZelle = 'C' + STRING(VLine).
  330. excelAppl:Range(VZelle):Select.
  331. excelAppl:ActiveCell:FormulaR1C1 = STRING(Artst.Jahr ,"9999").
  332. END.
  333. IF Artst.Alk_Gehalt > 0 THEN DO:
  334. VZelle = 'D' + STRING(VLine).
  335. excelAppl:Range(VZelle):Select.
  336. excelAppl:ActiveCell:FormulaR1C1 = STRING(Artst.Alk_Gehalt,"z9.99%").
  337. END.
  338. VZelle = 'E' + STRING(VLine).
  339. excelAppl:Range(VZelle):Select.
  340. excelAppl:ActiveCell:FormulaR1C1 = KGebinde.KBez.
  341. VZelle = 'F' + STRING(VLine).
  342. excelAppl:Range(VZelle):Select.
  343. excelAppl:ActiveCell:FormulaR1C1 = STRING(BBonusAbr.Menge ,"->>>>>>>>9").
  344. VZelle = 'G' + STRING(VLine).
  345. excelAppl:Range(VZelle):Select.
  346. excelAppl:ActiveCell:FormulaR1C1 = STRING(BBonusAbr.Volumen ,"->>>>>>>>9").
  347. VZelle = 'H' + STRING(VLine).
  348. excelAppl:Range(VZelle):Select.
  349. excelAppl:ActiveCell:FormulaR1C1 = STRING(BBonusAbr.Betrag ,"->>>>>>>>9").
  350. VZelle = 'I' + STRING(VLine).
  351. excelAppl:Range(VZelle):Select.
  352. excelAppl:ActiveCell:FormulaR1C1 = VRabatt.
  353. VZelle = 'J' + STRING(VLine).
  354. excelAppl:Range(VZelle):Select.
  355. excelAppl:ActiveCell:FormulaR1C1 = STRING(BBonusAbr.Bonus ,"->>>>9.99").
  356. VLine = VLine + 1.
  357. FIND TWork USE-INDEX TWork-k1
  358. WHERE TWork.SummGrp = BBonusAbr.SummGrp
  359. AND TWork.MWST% = BBonusAbr.MWST-% NO-ERROR.
  360. IF NOT AVAILABLE TWork THEN DO:
  361. CREATE TWork.
  362. ASSIGN TWork.SummGrp = BBonusAbr.SummGrp
  363. TWork.MWST% = BBonusAbr.MWST-%.
  364. END.
  365. TWork.Menge = TWork.Menge + BBonusAbr.Menge.
  366. TWork.Liter = TWork.Liter + BBonusAbr.Volumen.
  367. TWork.Betrag = TWork.Betrag + BBonusAbr.Betrag.
  368. TWork.Bonus = TWork.Bonus + BBonusAbr.Bonus.
  369. IF NOT LAST-OF ( BBonusAbr.SummGrp ) THEN NEXT.
  370. VTotal = 0.
  371. FOR EACH TWork WHERE TWork.SummGrp = BBonusAbr.SummGrp NO-LOCK:
  372. VTotal[01] = VTotal[01] + TWork.Menge.
  373. VTotal[02] = VTotal[02] + TWork.Liter.
  374. VTotal[03] = VTotal[03] + TWork.Betrag.
  375. VTotal[04] = VTotal[04] + TWork.Bonus.
  376. END.
  377. VLine = VLine + 1.
  378. VZelle = 'F' + STRING(VLine).
  379. excelAppl:Range(VZelle):Select.
  380. excelAppl:ActiveCell:FormulaR1C1 = STRING(VTotal[01],"->>>>>>>>9").
  381. VZelle = 'G' + STRING(VLine).
  382. excelAppl:Range(VZelle):Select.
  383. excelAppl:ActiveCell:FormulaR1C1 = STRING(VTotal[02],"->>>>>>>>9").
  384. VZelle = 'H' + STRING(VLine).
  385. excelAppl:Range(VZelle):Select.
  386. excelAppl:ActiveCell:FormulaR1C1 = STRING(VTotal[03],"->>>>>>>>9").
  387. VZelle = 'J' + STRING(VLine).
  388. excelAppl:Range(VZelle):Select.
  389. excelAppl:ActiveCell:FormulaR1C1 = STRING(VTotal[04],"->>>>9.99").
  390. VZelle = 'F' + STRING(VLine) + ":J" + STRING(VLine).
  391. excelAppl:Range(VZelle):Select.
  392. excelAppl:ActiveCell:Font:Bold = TRUE.
  393. excelAppl:Rows(VLine):Select.
  394. excelAppl:Selection:Font:Bold = TRUE.
  395. VLine = VLine + 1.
  396. END.
  397. VTotal = 0.
  398. Zuszz = 3.
  399. FOR EACH TWork NO-LOCK
  400. BREAK BY TWork.MWST%:
  401. VTotal[06] = VTotal[06] + TWork.Menge.
  402. VTotal[07] = VTotal[07] + TWork.Liter.
  403. VTotal[08] = VTotal[08] + TWork.Betrag.
  404. VTotal[09] = VTotal[09] + TWork.Bonus.
  405. IF FIRST-OF ( TWork.MWST% ) THEN Zuszz = Zuszz + 1.
  406. END.
  407. i1 = (VLine + Zuszz - (VLine MOD 40)) / 40.
  408. IF i1 > (VSeite - 1) THEN DO:
  409. TiDruck = TRUE.
  410. RUN TITEL.
  411. TiDruck = FALSE.
  412. END.
  413. ELSE VLine = VLine + 1.
  414. VZelle = 'B' + STRING(VLine).
  415. excelAppl:Range(VZelle):Select.
  416. excelAppl:ActiveCell:FormulaR1C1 = 'Total Bonusbetrag'.
  417. VZelle = 'J' + STRING(VLine).
  418. excelAppl:Range(VZelle):Select.
  419. excelAppl:ActiveCell:FormulaR1C1 = STRING(VTotal[09],"->>>>9.99").
  420. excelAppl:Rows(VLine):Select.
  421. excelAppl:Selection:Font:Bold = TRUE.
  422. VLine = VLine + 1.
  423. VBuchen = 0.
  424. VAnsatz = 0.
  425. i5 = 0.
  426. FOR EACH TWork
  427. BREAK BY TWork.MWST%:
  428. VTotal[01] = VTotal[01] + TWork.Menge.
  429. VTotal[02] = VTotal[02] + TWork.Liter.
  430. VTotal[03] = VTotal[03] + TWork.Betrag.
  431. VTotal[04] = VTotal[04] + TWork.Bonus.
  432. IF NOT LAST-OF ( TWork.MWST% ) THEN NEXT.
  433. Rundbetr = VTotal[04] * TWork.MWST% / 100.
  434. VTotal[09] = VTotal[09] + Rundbetr.
  435. i5 = i5 + 1.
  436. VBuchen[i5] = VTotal[04].
  437. VAnsatz[i5] = TWork.MWST%.
  438. VZelle = 'E' + STRING(VLine).
  439. excelAppl:Range(VZelle):Select.
  440. excelAppl:ActiveCell:FormulaR1C1 = 'MWST ' + STRING(TWork.MWST%,"z9.99%").
  441. VZelle = 'H' + STRING(VLine).
  442. excelAppl:Range(VZelle):Select.
  443. excelAppl:ActiveCell:FormulaR1C1 = STRING(VTotal[04],"->>>>>>>>9").
  444. VZelle = 'J' + STRING(VLine).
  445. excelAppl:Range(VZelle):Select.
  446. excelAppl:ActiveCell:FormulaR1C1 = STRING(Rundbetr ,"->>>>9.99").
  447. VLine = VLine + 1.
  448. VTotal[01] = 0.
  449. VTotal[02] = 0.
  450. VTotal[03] = 0.
  451. VTotal[04] = 0.
  452. VTotal[05] = 0.
  453. END.
  454. Rundbetr = VTotal[09].
  455. Rundcode = 1.
  456. RUN "v8/runden.p".
  457. VTotal[09] = Rundbetr.
  458. VZelle = 'B' + STRING(VLine).
  459. excelAppl:Range(VZelle):Select.
  460. excelAppl:ActiveCell:FormulaR1C1 = 'Bonusgutschrift inklusive Mehrwertsteuer'.
  461. VZelle = 'J' + STRING(VLine).
  462. excelAppl:Range(VZelle):Select.
  463. excelAppl:ActiveCell:FormulaR1C1 = STRING(VTotal[09],"->>>>9.99").
  464. excelAppl:Rows(VLine):Select.
  465. excelAppl:Selection:Font:Bold = TRUE.
  466. VLine = VLine + 1.
  467. excelAppl:Application:Run('SeitenWechsel').
  468. /*
  469. excelAppl:Visible = FALSE.
  470. */
  471. LVKnr = BonusAbr.Knr.
  472. LVRecid = RECID(BonusAbr).
  473. RUN "v8/d-bonusbuchen.w".
  474. /*
  475. excelAppl:Visible = TRUE.
  476. */
  477. RELEASE OBJECT excelAppl.
  478. RUN OPEN_BonusAbr.
  479. END.
  480. END.
  481. /* _UIB-CODE-BLOCK-END */
  482. &ANALYZE-RESUME
  483. &UNDEFINE SELF-NAME
  484. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK F-Frame-Win
  485. /* *************************** Main Block *************************** */
  486. SUBSCRIBE TO 'BONUSLAGER' ANYWHERE.
  487. &IF DEFINED(UIB_IS_RUNNING) <> 0 &THEN
  488. /* Now enable the interface if in test mode - otherwise this happens when
  489. the object is explicitly initialized from its container. */
  490. RUN dispatch IN THIS-PROCEDURE ('initialize':U).
  491. &ENDIF
  492. /* _UIB-CODE-BLOCK-END */
  493. &ANALYZE-RESUME
  494. /* ********************** Internal Procedures *********************** */
  495. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-create-objects F-Frame-Win _ADM-CREATE-OBJECTS
  496. PROCEDURE adm-create-objects :
  497. /*------------------------------------------------------------------------------
  498. Purpose: Create handles for all SmartObjects used in this procedure.
  499. After SmartObjects are initialized, then SmartLinks are added.
  500. Parameters: <none>
  501. ------------------------------------------------------------------------------*/
  502. END PROCEDURE.
  503. /* _UIB-CODE-BLOCK-END */
  504. &ANALYZE-RESUME
  505. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE adm-row-available F-Frame-Win _ADM-ROW-AVAILABLE
  506. PROCEDURE adm-row-available :
  507. /*------------------------------------------------------------------------------
  508. Purpose: Dispatched to this procedure when the Record-
  509. Source has a new row available. This procedure
  510. tries to get the new row (or foriegn keys) from
  511. the Record-Source and process it.
  512. Parameters: <none>
  513. ------------------------------------------------------------------------------*/
  514. /* Define variables needed by this internal procedure. */
  515. {src/adm/template/row-head.i}
  516. /* Process the newly available records (i.e. display fields,
  517. open queries, and/or pass records on to any RECORD-TARGETS). */
  518. {src/adm/template/row-end.i}
  519. END PROCEDURE.
  520. /* _UIB-CODE-BLOCK-END */
  521. &ANALYZE-RESUME
  522. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BONUSLAGER F-Frame-Win
  523. PROCEDURE BONUSLAGER :
  524. /*------------------------------------------------------------------------------
  525. Purpose:
  526. Parameters: <none>
  527. Notes:
  528. ------------------------------------------------------------------------------*/
  529. DEF INPUT PARAMETER ipLager AS INT NO-UNDO.
  530. iLager = ipLager.
  531. DO WITH FRAME {&FRAME-NAME}:
  532. APPLY 'ENTRY' TO BROWSE {&BROWSE-NAME}.
  533. RETURN NO-APPLY.
  534. END.
  535. END PROCEDURE.
  536. /* _UIB-CODE-BLOCK-END */
  537. &ANALYZE-RESUME
  538. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE CREATE_EXCEL F-Frame-Win
  539. PROCEDURE CREATE_EXCEL :
  540. /*------------------------------------------------------------------------------
  541. Purpose:
  542. Parameters: <none>
  543. Notes:
  544. ------------------------------------------------------------------------------*/
  545. DEF INPUT PARAMETER VVorlage AS CHAR NO-UNDO.
  546. DEF INPUT PARAMETER VDatei AS CHAR NO-UNDO.
  547. DEF INPUT PARAMETER VMakro AS CHAR NO-UNDO.
  548. DEF VAR MyFile AS CHAR NO-UNDO.
  549. DEF VAR VWert AS CHAR NO-UNDO.
  550. DO WHILE TRUE:
  551. GET-KEY-VALUE SECTION 'Einstellungen'
  552. KEY 'InstallPfad'
  553. VALUE VWert.
  554. IF VWert = ? OR
  555. VWert = '' THEN DO:
  556. FILE-INFO:FILE-NAME = 'Ge_MIS.ini'.
  557. VWert = REPLACE(FILE-INFO:FULL-PATHNAME, FILE-INFO:FILE-NAME, '').
  558. VWert = SUBSTRIN(VWert,01,LENGTH(VWert) - 1).
  559. END.
  560. IF INDEX(PROPATH, VWert) = 0 THEN DO:
  561. PROPATH = VWert + "," + PROPATH.
  562. END.
  563. excelAppl = ?.
  564. MyFile = SEARCH(VVorlage).
  565. IF MyFile = ? THEN DO:
  566. MESSAGE 'Vorlage ' VVorlage ' nicht gefunden' VIEW-AS ALERT-BOX.
  567. RETURN.
  568. END.
  569. DO WHILE TRUE TRANSACTION:
  570. FIND Tabel USE-INDEX Tabel-k1
  571. WHERE Tabel.Firma = GVFirma
  572. AND Tabel.RecArt = 'TEMPFILE'
  573. AND Tabel.CodeI = 0
  574. AND Tabel.CodeC = 'EXCEL'
  575. AND Tabel.Sprcd = 1 NO-ERROR.
  576. IF NOT AVAILABLE Tabel THEN DO:
  577. CREATE Tabel.
  578. ASSIGN Tabel.Firma = GVFirma
  579. Tabel.RecArt = 'TEMPFILE'
  580. Tabel.CodeI = 0
  581. Tabel.CodeC = 'EXCEL'
  582. Tabel.Sprcd = 1
  583. Tabel.Bez1 = SESSION:TEMP-DIR.
  584. END.
  585. Tabel.Int_1 = Tabel.Int_1 + 1.
  586. IF VDatei = '' THEN VDatei = Tabel.Bez1 + STRING(Tabel.Int_1) + '.tmp'.
  587. ELSE VDatei = Tabel.Bez1 + VDatei.
  588. RELEASE Tabel.
  589. LEAVE.
  590. END.
  591. OS-COPY VALUE(MyFile) VALUE(VDatei).
  592. CREATE 'Excel.Application' excelAppl.
  593. excelAppl:Visible = TRUE.
  594. excelAppl:Workbooks:Open(VDatei, True).
  595. LEAVE.
  596. END.
  597. RETURN.
  598. /*
  599. excelAppl:Application:Run('Bestell').
  600. */
  601. END PROCEDURE.
  602. /* _UIB-CODE-BLOCK-END */
  603. &ANALYZE-RESUME
  604. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE disable_UI F-Frame-Win _DEFAULT-DISABLE
  605. PROCEDURE disable_UI :
  606. /*------------------------------------------------------------------------------
  607. Purpose: DISABLE the User Interface
  608. Parameters: <none>
  609. Notes: Here we clean-up the user-interface by deleting
  610. dynamic widgets we have created and/or hide
  611. frames. This procedure is usually called when
  612. we are ready to "clean-up" after running.
  613. ------------------------------------------------------------------------------*/
  614. /* Hide all frames. */
  615. HIDE FRAME F-Main.
  616. IF THIS-PROCEDURE:PERSISTENT THEN DELETE PROCEDURE THIS-PROCEDURE.
  617. END PROCEDURE.
  618. /* _UIB-CODE-BLOCK-END */
  619. &ANALYZE-RESUME
  620. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE enable_UI F-Frame-Win _DEFAULT-ENABLE
  621. PROCEDURE enable_UI :
  622. /*------------------------------------------------------------------------------
  623. Purpose: ENABLE the User Interface
  624. Parameters: <none>
  625. Notes: Here we display/view/enable the widgets in the
  626. user-interface. In addition, OPEN all queries
  627. associated with each FRAME and BROWSE.
  628. These statements here are based on the "Other
  629. Settings" section of the widget Property Sheets.
  630. ------------------------------------------------------------------------------*/
  631. ENABLE RECT-21 Br_Bonus_1
  632. WITH FRAME F-Main.
  633. {&OPEN-BROWSERS-IN-QUERY-F-Main}
  634. END PROCEDURE.
  635. /* _UIB-CODE-BLOCK-END */
  636. &ANALYZE-RESUME
  637. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE local-view F-Frame-Win
  638. PROCEDURE local-view :
  639. /*------------------------------------------------------------------------------
  640. Purpose: Override standard ADM method
  641. Notes:
  642. ------------------------------------------------------------------------------*/
  643. RUN dispatch IN THIS-PROCEDURE ( INPUT 'view':U ) .
  644. RUN OPEN_BonusAbr.
  645. PUBLISH 'GETBONUSLAGER' ( OUTPUT iLager ).
  646. APPLY 'ENTRY' TO BROWSE Br_Bonus_1.
  647. END PROCEDURE.
  648. /* _UIB-CODE-BLOCK-END */
  649. &ANALYZE-RESUME
  650. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE OPEN_BonusAbr F-Frame-Win
  651. PROCEDURE OPEN_BonusAbr :
  652. /*------------------------------------------------------------------------------
  653. Purpose:
  654. Parameters: <none>
  655. Notes:
  656. ------------------------------------------------------------------------------*/
  657. DO WITH FRAME {&FRAME-NAME}:
  658. IF NUM-RESULTS("{&BROWSE-NAME}":U) <> ? THEN CLOSE QUERY Br_Bonus_1.
  659. OPEN QUERY Br_Bonus_1
  660. FOR EACH BonusAbr USE-INDEX BonusAbr-k1
  661. WHERE BonusAbr.Firma = GVFirma
  662. AND BonusAbr.Bon_Sta = 1 NO-LOCK.
  663. END.
  664. END PROCEDURE.
  665. /* _UIB-CODE-BLOCK-END */
  666. &ANALYZE-RESUME
  667. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE send-records F-Frame-Win _ADM-SEND-RECORDS
  668. PROCEDURE send-records :
  669. /*------------------------------------------------------------------------------
  670. Purpose: Send record ROWID's for all tables used by
  671. this file.
  672. Parameters: see template/snd-head.i
  673. ------------------------------------------------------------------------------*/
  674. /* Define variables needed by this internal procedure. */
  675. {src/adm/template/snd-head.i}
  676. /* For each requested table, put it's ROWID in the output list. */
  677. {src/adm/template/snd-list.i "BonusAbr"}
  678. /* Deal with any unexpected table requests before closing. */
  679. {src/adm/template/snd-end.i}
  680. END PROCEDURE.
  681. /* _UIB-CODE-BLOCK-END */
  682. &ANALYZE-RESUME
  683. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE state-changed F-Frame-Win
  684. PROCEDURE state-changed :
  685. /* -----------------------------------------------------------
  686. Purpose:
  687. Parameters: <none>
  688. Notes:
  689. -------------------------------------------------------------*/
  690. DEFINE INPUT PARAMETER p-issuer-hdl AS HANDLE NO-UNDO.
  691. DEFINE INPUT PARAMETER p-state AS CHARACTER NO-UNDO.
  692. END PROCEDURE.
  693. /* _UIB-CODE-BLOCK-END */
  694. &ANALYZE-RESUME
  695. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE TEMP_FILE F-Frame-Win
  696. PROCEDURE TEMP_FILE :
  697. /*------------------------------------------------------------------------------
  698. Purpose:
  699. Parameters: <none>
  700. Notes:
  701. ------------------------------------------------------------------------------*/
  702. DO WHILE TRUE TRANSACTION:
  703. FIND Tabel USE-INDEX Tabel-k1
  704. WHERE Tabel.Firma = GVFirma
  705. AND Tabel.RecArt = 'TEMPFILE'
  706. AND Tabel.CodeI = 0
  707. AND Tabel.CodeC = 'EXCEL'
  708. AND Tabel.Sprcd = 1 NO-ERROR.
  709. IF NOT AVAILABLE Tabel THEN DO:
  710. CREATE Tabel.
  711. ASSIGN Tabel.Firma = GVFirma
  712. Tabel.RecArt = 'TEMPFILE'
  713. Tabel.CodeI = 0
  714. Tabel.CodeC = 'EXCEL'
  715. Tabel.Sprcd = 1
  716. Tabel.Bez1 = SESSION:TEMP-DIR.
  717. END.
  718. Tabel.Int_1 = Tabel.Int_1 + 1.
  719. VTemp = Tabel.Bez1 + 'Ge_MIS' + STRING(Tabel.Int_1) + '.tmp'.
  720. RELEASE Tabel.
  721. LEAVE.
  722. END.
  723. END PROCEDURE.
  724. /* _UIB-CODE-BLOCK-END */
  725. &ANALYZE-RESUME
  726. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE TITEL F-Frame-Win
  727. PROCEDURE TITEL :
  728. /*------------------------------------------------------------------------------
  729. Purpose:
  730. Parameters: <none>
  731. Notes:
  732. ------------------------------------------------------------------------------*/
  733. IF VSeite > 0 THEN DO:
  734. IF (VSeite * 40) < VLine THEN VLine = VSeite * 40.
  735. VLine = VLine + 1.
  736. VZelle = 'A' + STRING(VLine).
  737. excelAppl:Range(VZelle):Select.
  738. excelAppl:Selection:VALUE = "&SW&".
  739. END.
  740. VSeite = VSeite + 1.
  741. VLine = VLine + 1.
  742. DO ix = 3 TO 9:
  743. VZelle = 'A' + TRIM(STRING(VLine)).
  744. excelAppl:Range(VZelle):Select.
  745. excelAppl:ActiveCell = TRIM(VAnschrift[ix]).
  746. IF ix = 8 THEN DO:
  747. excelAppl:ActiveCell:Font:Bold = TRUE.
  748. END.
  749. VLine = VLine + 1.
  750. END.
  751. VZelle = 'C' + STRING(VLine - 3).
  752. excelAppl:Range(VZelle):Select.
  753. excelAppl:ActiveCell = 'Bonusabrechnung '
  754. + STRING(BBonusAbr.VonDatum,"99.99.9999")
  755. + " - "
  756. + STRING(BBonusAbr.BisDatum,"99.99.9999").
  757. excelAppl:ActiveCell:Font:Bold = TRUE.
  758. excelAppl:ActiveCell:Font:Size = 12.
  759. VLine = ((VSeite - 1) * 40) + 9.
  760. IF VSeite > 1 THEN DO:
  761. excelAppl:Range("A9:J9"):Select.
  762. excelAppl:Selection:Copy.
  763. VZelle = 'A' + STRING(VLine) + ":J" + STRING(VLine).
  764. excelAppl:Range(VZelle):Select.
  765. excelAppl:ActiveSheet:Paste.
  766. END.
  767. VLine = VLine + 1.
  768. END PROCEDURE.
  769. /* _UIB-CODE-BLOCK-END */
  770. &ANALYZE-RESUME