Offerte.p 43 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211
  1. &ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12
  2. &ANALYZE-RESUME
  3. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
  4. /*------------------------------------------------------------------------
  5. File :
  6. Purpose :
  7. Syntax :
  8. Description :
  9. Author(s) :
  10. Created :
  11. Notes :
  12. ----------------------------------------------------------------------*/
  13. /* This .W file was created with the Progress AppBuilder. */
  14. /*----------------------------------------------------------------------*/
  15. /* *************************** Definitions ************************** */
  16. DEF INPUT PARAMETER iphParam AS HANDLE NO-UNDO.
  17. DEF OUTPUT PARAMETER opcResult AS CHAR NO-UNDO.
  18. DEF VAR iSeite AS INT NO-UNDO.
  19. DEF VAR iAnzDok AS INT NO-UNDO.
  20. DEF VAR iLauf AS INT NO-UNDO.
  21. DEF VAR lFirst AS LOG INIT FALSE NO-UNDO.
  22. DEF VAR lLast AS LOG INIT FALSE NO-UNDO.
  23. DEF VAR lPreis AS LOG NO-UNDO.
  24. DEF VAR cFirma AS CHAR NO-UNDO.
  25. DEF VAR AdFirma AS CHAR NO-UNDO.
  26. DEF VAR nFakBetr AS DEC NO-UNDO.
  27. DEF VAR dFakDatum AS DATE NO-UNDO.
  28. DEF VAR iFaknr AS INT NO-UNDO.
  29. DEF VAR iSprcd AS INT NO-UNDO.
  30. DEF VAR nTotale AS DEC EXTENT 15 NO-UNDO.
  31. DEF VAR cFormtext AS CHAR EXTENT 30 NO-UNDO.
  32. DEF VAR cRabText AS CHAR NO-UNDO.
  33. DEF VAR cZusText AS CHAR NO-UNDO.
  34. DEF VAR cEpzText AS CHAR NO-UNDO.
  35. DEF VAR cBesrKopf AS CHAR EXTENT 12 NO-UNDO.
  36. DEF VAR lDebIncl AS LOG NO-UNDO.
  37. DEF VAR Rundbetr AS DEC DECIMALS 4 NO-UNDO.
  38. DEF VAR RundCode AS INT INIT 1 NO-UNDO.
  39. DEF VAR htTabTexte AS HANDLE NO-UNDO.
  40. DEF VAR hAufko AS HANDLE NO-UNDO.
  41. DEF BUFFER bAufko FOR Aufko .
  42. DEF BUFFER bAufze FOR Aufze .
  43. DEF BUFFER FDebst FOR Debst . /* Fakturaadresse */
  44. DEF BUFFER LDebst FOR Debst . /* Lieferadresse */
  45. DEF BUFFER LAdresse FOR Adresse .
  46. DEF BUFFER bAdresse FOR Adresse .
  47. DEF BUFFER bWust FOR Wust .
  48. DEF BUFFER bSteuer FOR Steuer .
  49. DEF VAR hExcel AS COM-HANDLE NO-UNDO.
  50. DEF VAR cZelle AS CHAR NO-UNDO.
  51. DEF VAR iZeile AS INT NO-UNDO.
  52. { incl/ttdruckparam.i }
  53. DEF TEMP-TABLE tTotale
  54. FIELD nMwstPfl AS DEC EXTENT 12
  55. FIELD nMwstBet AS DEC EXTENT 12
  56. FIELD nSammTot AS DEC
  57. FIELD nSkBer AS DEC
  58. FIELD nWW AS DEC
  59. .
  60. DEF TEMP-TABLE sAufko
  61. FIELD cFirma AS CHAR
  62. FIELD iAufnr AS INT
  63. FIELD iFak_Knr AS INT
  64. FIELD iSamm_Nr AS INT
  65. FIELD iRecid AS RECID
  66. FIELD iFaknr AS INT
  67. .
  68. DEF TEMP-TABLE tAufko LIKE Aufko
  69. FIELD iRecid AS RECID
  70. .
  71. DEF TEMP-TABLE tAufze
  72. FIELD Aufnr AS INT
  73. FIELD Sort1 AS CHAR
  74. FIELD Sort2 AS CHAR
  75. FIELD Sort3 AS CHAR
  76. FIELD Artnr AS INT
  77. FIELD Inhalt AS INT
  78. FIELD Jahr AS INT
  79. FIELD Pos AS INT
  80. FIELD Zeile AS RECID
  81. FIELD Preis AS DEC DECIMALS 4
  82. FIELD Aktion AS LOG
  83. FIELD LagOrt AS CHAR
  84. FIELD MGeli AS DEC
  85. FIELD MRuek AS DEC
  86. INDEX tAufze-k1 IS PRIMARY
  87. Aufnr
  88. Sort1
  89. Sort2
  90. Sort3
  91. .
  92. DEF TEMP-TABLE tSpeRab
  93. FIELD Rab_Grp AS INT
  94. FIELD Auf_Betr AS DEC DECIMALS 4
  95. .
  96. DEF TEMP-TABLE tGebKto
  97. FIELD Sort_Cd AS CHAR
  98. FIELD Geb_Cd AS CHAR
  99. FIELD Bez AS CHAR
  100. FIELD Preis AS DEC
  101. FIELD A_Anz AS DEC
  102. FIELD A_Betrag AS DEC
  103. FIELD E_Anz AS DEC
  104. FIELD E_Betrag AS DEC
  105. FIELD MWST_Art AS INT
  106. FIELD MWST_Cd AS INT
  107. .
  108. DEF TEMP-TABLE tRabSumm
  109. FIELD Rab_Summ AS INT
  110. FIELD Bez AS CHAR
  111. FIELD F_Rab_Art AS INT
  112. FIELD F_Wert AS DEC DECIMALS 4
  113. FIELD A_Rab_Art AS INT
  114. FIELD A_Wert AS DEC DECIMALS 4
  115. FIELD Auf_Rab AS DEC DECIMALS 4
  116. FIELD Abh_Rab AS DEC DECIMALS 4
  117. .
  118. DEF TEMP-TABLE tTabTexte
  119. FIELD cRecArt AS CHAR
  120. FIELD iZeile AS INT
  121. FIELD cFeld1 AS CHAR
  122. FIELD cFeld2 AS CHAR
  123. FIELD cFeld3 AS CHAR
  124. FIELD iFeld1 AS INT
  125. FIELD iFeld2 AS INT
  126. FIELD iFeld3 AS INT
  127. INDEX tTabTexte-k1 IS PRIMARY
  128. cRecArt
  129. iZeile.
  130. /* _UIB-CODE-BLOCK-END */
  131. &ANALYZE-RESUME
  132. &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  133. /* ******************** Preprocessor Definitions ******************** */
  134. &Scoped-define PROCEDURE-TYPE Procedure
  135. &Scoped-define DB-AWARE no
  136. /* _UIB-PREPROCESSOR-BLOCK-END */
  137. &ANALYZE-RESUME
  138. /* *********************** Procedure Settings ************************ */
  139. &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  140. /* Settings for THIS-PROCEDURE
  141. Type: Procedure
  142. Allow:
  143. Frames: 0
  144. Add Fields to: Neither
  145. Other Settings: CODE-ONLY COMPILE
  146. */
  147. &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  148. /* ************************* Create Window ************************** */
  149. &ANALYZE-SUSPEND _CREATE-WINDOW
  150. /* DESIGN Window definition (used by the UIB)
  151. CREATE WINDOW Procedure ASSIGN
  152. HEIGHT = 15
  153. WIDTH = 60.
  154. /* END WINDOW DEFINITION */
  155. */
  156. &ANALYZE-RESUME
  157. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
  158. /* *************************** Main Block *************************** */
  159. opcResult = ''.
  160. CREATE tParam.
  161. htParam:BUFFER-COPY(iphParam).
  162. ASSIGN cFirma = tParam.cFirma
  163. iAnzDok = 1.
  164. FIND bSteuer NO-LOCK WHERE bSteuer.Firma = cFirma.
  165. AdFirma = bSteuer.AdFirma.
  166. RUN AUFTRAG_ERMITTELN.
  167. IF opcResult <> '' THEN RETURN.
  168. FOR EACH sAufko
  169. BY sAufko.iFak_Knr:
  170. FIND bAdresse NO-LOCK
  171. WHERE bAdresse.Firma = AdFirma
  172. AND bAdresse.Knr = sAufko.iFak_Knr.
  173. iSprcd = bAdresse.Sprcd.
  174. RUN GET_FORMTEXT ( tParam.cInstall, tParam.cDokument, iSprcd,
  175. OUTPUT cFormText ) NO-ERROR.
  176. cRabText = TRIM(SUBSTRING(cFormText[21],01,20)).
  177. cZusText = TRIM(SUBSTRING(cFormText[21],21,20)).
  178. cEpzText = TRIM(SUBSTRING(cFormText[21],41,20)).
  179. RELEASE bAdresse.
  180. DO iLauf = 1 TO iAnzDok:
  181. dFakDatum = TODAY.
  182. iSeite = 0.
  183. iFaknr = sAufko.iAufnr.
  184. lFirst = TRUE.
  185. lPreis = TRUE.
  186. lLast = FALSE.
  187. EMPTY TEMP-TABLE tTotale .
  188. CREATE tTotale.
  189. FOR EACH bAufko NO-LOCK
  190. WHERE bAufko.Firma = sAufko.cFirma
  191. AND bAufko.Aufnr = sAufko.iAufnr:
  192. EMPTY TEMP-TABLE tAufze .
  193. EMPTY TEMP-TABLE tGebKto .
  194. EMPTY TEMP-TABLE tRabSumm .
  195. EMPTY TEMP-TABLE tSpeRab .
  196. EMPTY TEMP-TABLE tTabTexte .
  197. FIND bAdresse NO-LOCK USE-INDEX Adresse-k1
  198. WHERE bAdresse.Firma = AdFirma
  199. AND bAdresse.Knr = bAufko.Fak_Knr NO-ERROR.
  200. FIND LDebst NO-LOCK USE-INDEX Debst-k1
  201. WHERE LDebst.Firma = cFirma
  202. AND LDebst.Knr = bAufko.Knr NO-ERROR.
  203. FIND FDebst NO-LOCK USE-INDEX Debst-k1
  204. WHERE FDebst.Firma = cFirma
  205. AND FDebst.Knr = bAufko.Fak_Knr NO-ERROR.
  206. FIND bWust NO-LOCK USE-INDEX Wust-k1
  207. WHERE bWust.CodeK = LDebst.MWST
  208. AND bWust.CodeA = 99 NO-ERROR.
  209. lDebIncl = FALSE.
  210. IF AVAILABLE bWust THEN lDebIncl = bWust.Incl.
  211. /* Texte und Werte aus Tabelle 'Tabel' laden für RecArt */
  212. /* FAKART, AUFSTATUS, LIEFART, FAHRER, WISO, ABLAD */
  213. hAufko = BUFFER bAufko:HANDLE.
  214. htTabTexte = TEMP-TABLE tTabTexte:DEFAULT-BUFFER-HANDLE.
  215. RUN CREATE_TABTEXTE ( hAufko, INPUT-OUTPUT htTabTexte ) NO-ERROR.
  216. RUN FUELLEN_tAufze ( bAufko.Aufnr ) NO-ERROR.
  217. FOR EACH tAufze
  218. WHERE tAufze.Artnr > 0:
  219. FIND bAufze NO-LOCK WHERE RECID(bAufze) = tAufze.Zeile.
  220. /* Spezial-Auftragsrabatt pro Lieferschein bilden */
  221. IF bAufze.Auf_Sp_Grp > 0 THEN DO:
  222. FIND FIRST tSpeRab
  223. WHERE tSpeRab.Rab_Grp = bAufze.Auf_Sp_Grp NO-ERROR.
  224. IF NOT AVAILABLE tSpeRab THEN DO:
  225. CREATE tSpeRab.
  226. ASSIGN tSpeRab.Rab_Grp = bAufze.Auf_Sp_Grp.
  227. END.
  228. tSpeRab.Auf_Betr = tSpeRab.Auf_Betr + bAufze.Auf_Sp_Rab.
  229. END.
  230. /* Summengruppen-Totale pro Lieferschein bilden */
  231. DO WHILE bAufze.Rab_Su_Grp > 0:
  232. FIND FIRST tRabSumm
  233. WHERE tRabSumm.Rab_Summ = bAufze.Rab_Su_Grp NO-ERROR.
  234. IF NOT AVAILABLE tRabSumm THEN DO:
  235. FIND FIRST RabSumm NO-LOCK
  236. WHERE RabSumm.Firma = bAufze.Firma
  237. AND RabSumm.Rab_Summ = bAufze.Rab_Su_Grp NO-ERROR.
  238. IF NOT AVAILABLE RabSumm THEN LEAVE.
  239. CREATE tRabSumm.
  240. ASSIGN tRabSumm.Rab_Summ = bAufze.Rab_Su_Grp
  241. tRabSumm.Bez = RabSumm.Bez
  242. tRabSumm.Auf_Rab = 0
  243. tRabSumm.Abh_Rab = 0.
  244. END.
  245. LEAVE.
  246. END.
  247. END.
  248. RUN DRUCKEN.
  249. END.
  250. END.
  251. END.
  252. /* _UIB-CODE-BLOCK-END */
  253. &ANALYZE-RESUME
  254. /* ********************** Internal Procedures *********************** */
  255. &IF DEFINED(EXCLUDE-ARTIKELZEILE) = 0 &THEN
  256. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ARTIKELZEILE Procedure
  257. PROCEDURE ARTIKELZEILE :
  258. /*------------------------------------------------------------------------------
  259. Purpose:
  260. Parameters: <none>
  261. Notes:
  262. ------------------------------------------------------------------------------*/
  263. DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO.
  264. DEF VAR cString AS CHAR NO-UNDO.
  265. DEF VAR nRabWert AS DEC NO-UNDO.
  266. DEF VAR xRabText AS CHAR NO-UNDO.
  267. FIND tAufze WHERE RECID(tAufze) = ipRecid NO-LOCK.
  268. FIND Aufze WHERE RECID(Aufze) = tAufze.Zeile NO-LOCK.
  269. DO WHILE Aufze.Artnr = 0:
  270. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D',
  271. INPUT iZeile, INPUT Aufze.Bez1 ).
  272. IF Aufze.Bez2 = '' THEN RETURN.
  273. iZeile = iZeile + 1.
  274. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D',
  275. INPUT iZeile, INPUT Aufze.Bez2 ).
  276. RETURN.
  277. END.
  278. FIND Artst OF Aufze NO-LOCK.
  279. FIND GGebinde NO-LOCK
  280. WHERE GGebinde.Firma = cFirma
  281. AND GGebinde.Geb_Cd = Aufze.GGeb_Cd NO-ERROR.
  282. FIND VGebinde NO-LOCK
  283. WHERE VGebinde.Firma = cFirma
  284. AND VGebinde.Geb_Cd = Aufze.VGeb_Cd NO-ERROR.
  285. FIND KGebinde NO-LOCK
  286. WHERE KGebinde.Firma = cFirma
  287. AND KGebinde.Geb_Cd = Aufze.KGeb_Cd NO-ERROR.
  288. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'A',
  289. INPUT iZeile, INPUT KGebinde.KBez ).
  290. IF Aufze.VGeb_Me <> 0 THEN DO:
  291. cString = STRING(Aufze.VGeb_Me,'->>>')
  292. + 'x '
  293. + STRING(VGebinde.KBez,'x(10)').
  294. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'B',
  295. INPUT iZeile, INPUT cString ).
  296. END.
  297. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C',
  298. INPUT iZeile, INPUT STRING(Aufze.MGeli,'->>>>>9') ).
  299. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D',
  300. INPUT iZeile, INPUT Aufze.Bez1 ).
  301. IF Aufze.Jahr > 9 THEN
  302. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'E',
  303. INPUT iZeile, INPUT STRING(Aufze.Jahr,'9999') ).
  304. IF Aufze.Alk_Gehalt <> 0 THEN
  305. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'F',
  306. INPUT iZeile, INPUT STRING(Aufze.Alk_Gehalt,'zz9.9%') ).
  307. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'G',
  308. INPUT iZeile, INPUT STRING(Aufze.Artnr,'999999') ).
  309. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'H',
  310. INPUT iZeile, INPUT STRING(Aufze.Preis,'>>>>9.99') ).
  311. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'I',
  312. INPUT iZeile, INPUT STRING(Aufze.Bru_Betr,'->>>>>9.99') ).
  313. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'J',
  314. INPUT iZeile, INPUT STRING(Aufze.WuCd,'z9') ).
  315. IF Aufze.Bez2 <> '' THEN DO:
  316. iZeile = iZeile + 1.
  317. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D',
  318. INPUT iZeile, INPUT Aufze.Bez2 ).
  319. END.
  320. IF Aufze.Aktion THEN DO:
  321. iZeile = iZeile + 1.
  322. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D',
  323. INPUT iZeile, INPUT Aufze.Aktion_Text ).
  324. END.
  325. DO WHILE TRUE:
  326. IF Aufze.Rab_Betr = 0 THEN LEAVE.
  327. nRabWert = ABSOLUTE(Aufze.Rab_Wert).
  328. IF Aufze.Rab_Art = 3 THEN xRabText = cEpzText.
  329. ELSE DO:
  330. IF Aufze.Rab_Betr < 0 THEN xRabText = cZusText.
  331. IF Aufze.Rab_Betr > 0 THEN xRabText = cRabText.
  332. END.
  333. iZeile = iZeile + 1.
  334. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D',
  335. INPUT iZeile, INPUT TRIM(xRabText) ).
  336. IF Aufze.Rab_Art = 1
  337. THEN RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'H',
  338. INPUT iZeile, INPUT TRIM(STRING(nRabWert,"->9.9 %")) ).
  339. IF Aufze.Rab_Art = 2 OR
  340. Aufze.Rab_Art = 3
  341. THEN RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'H',
  342. INPUT iZeile, INPUT TRIM(STRING(nRabWert,"->9.99 CHF")) ).
  343. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'I',
  344. INPUT iZeile, INPUT TRIM(STRING(- Aufze.Rab_Betr ,"->>>9.99")) ).
  345. LEAVE.
  346. END.
  347. DO WHILE TRUE:
  348. IF Aufze.Zus_Betr = 0 THEN LEAVE.
  349. nRabWert = ABSOLUTE(Aufze.Zus_Wert).
  350. IF Aufze.Zus_Art = 3 THEN xRabText = cEpzText.
  351. ELSE DO:
  352. IF Aufze.Zus_Betr < 0 THEN xRabText = cRabText.
  353. IF Aufze.Zus_Betr > 0 THEN xRabText = cZusText.
  354. END.
  355. iZeile = iZeile + 1.
  356. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D',
  357. INPUT iZeile, INPUT TRIM(xRabText) ).
  358. IF Aufze.Zus_Art = 1
  359. THEN RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'H',
  360. INPUT iZeile, INPUT TRIM(STRING(nRabWert,"->9.9 %")) ).
  361. IF Aufze.Zus_Art = 2 OR
  362. Aufze.Zus_Art = 3
  363. THEN RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'H',
  364. INPUT iZeile, INPUT TRIM(STRING(nRabWert,"->9.99 CHF")) ).
  365. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'I',
  366. INPUT iZeile, INPUT TRIM(STRING(- Aufze.Zus_Betr ,"->>>9.99")) ).
  367. LEAVE.
  368. END.
  369. END PROCEDURE.
  370. /* _UIB-CODE-BLOCK-END */
  371. &ANALYZE-RESUME
  372. &ENDIF
  373. &IF DEFINED(EXCLUDE-AUFTRAG_ERMITTELN) = 0 &THEN
  374. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE AUFTRAG_ERMITTELN Procedure
  375. PROCEDURE AUFTRAG_ERMITTELN :
  376. /*------------------------------------------------------------------------------
  377. Purpose:
  378. Parameters: <none>
  379. Notes:
  380. ------------------------------------------------------------------------------*/
  381. DEF VAR iAufnr AS INT NO-UNDO.
  382. FIND FIRST tParam.
  383. EMPTY TEMP-TABLE sAufko.
  384. /* Sammeln aller Aufträge pro Sammelnummer */
  385. FOR EACH Aufko NO-LOCK USE-INDEX Aufko-k5
  386. WHERE Aufko.Firma = tParam.cFirma
  387. AND Aufko.Aufnr = tParam.iAufnr :
  388. CREATE sAufko.
  389. ASSIGN sAufko.cFirma = Aufko.Firma
  390. sAufko.iAufnr = Aufko.Aufnr
  391. sAufko.iFak_Knr = Aufko.Fak_Knr
  392. sAufko.iSamm_Nr = 0
  393. sAufko.iRecid = RECID(Aufko)
  394. sAufko.iFaknr = 0.
  395. END.
  396. /* Alle Auftragstotale aller Lieferscheine neu rechnen */
  397. FOR EACH sAufko:
  398. FOR EACH bAufko NO-LOCK
  399. WHERE bAufko.Firma = sAufko.cFirma
  400. AND bAufko.Samm_Nr = sAufko.iSamm_Nr
  401. AND bAufko.Fak_Knr = sAufko.iFak_Knr
  402. AND bAufko.Lief_Datum >= tParam.dvonDatum
  403. AND bAufko.Lief_Datum <= tParam.dbisDatum:
  404. DYNAMIC-FUNCTION('calculateAuftragsTotal':U, bAufko.Firma,
  405. bAufko.Aufnr,
  406. OUTPUT nTotale ) NO-ERROR.
  407. RELEASE bAufko.
  408. END.
  409. END.
  410. END PROCEDURE.
  411. /* _UIB-CODE-BLOCK-END */
  412. &ANALYZE-RESUME
  413. &ENDIF
  414. &IF DEFINED(EXCLUDE-DRUCKEN) = 0 &THEN
  415. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN Procedure
  416. PROCEDURE DRUCKEN :
  417. /*------------------------------------------------------------------------------
  418. Purpose:
  419. Parameters: <none>
  420. Notes:
  421. ------------------------------------------------------------------------------*/
  422. DEF VAR cLAdresse AS CHAR NO-UNDO.
  423. DEF VAR RText AS CHAR NO-UNDO.
  424. DEF VAR WText AS CHAR NO-UNDO.
  425. DEF VAR ii AS INT NO-UNDO.
  426. DEF VAR i1 AS INT NO-UNDO.
  427. DEF VAR nRabWert AS DEC NO-UNDO.
  428. DEF VAR iMwstCd AS INT NO-UNDO.
  429. DEF VAR nZeiTot AS DEC DECIMALS 4 NO-UNDO.
  430. DEF VAR cDaten AS CHAR NO-UNDO.
  431. FIND FIRST tParam.
  432. nFakBetr = 0.
  433. iZeile = 5.
  434. IF iSeite = 0 THEN RUN EXCEL_INIT.
  435. IF RETURN-VALUE <> '' THEN DO:
  436. MESSAGE 'Problem beim Öffnen von Excel und/oder Vorlage'
  437. VIEW-AS ALERT-BOX.
  438. RETURN 'ERROR'.
  439. END.
  440. FIND bAdresse NO-LOCK
  441. WHERE bAdresse.Firma = AdFirma
  442. AND bAdresse.Knr = bAufko.Knr NO-ERROR.
  443. FIND LDebst NO-LOCK
  444. WHERE LDebst.Firma = cFirma
  445. AND LDebst.Knr = bAufko.Knr NO-ERROR.
  446. FIND FDebst NO-LOCK
  447. WHERE FDebst.Firma = cFirma
  448. AND FDebst.Knr = bAufko.Fak_Knr NO-ERROR.
  449. FIND Wust NO-LOCK
  450. WHERE Wust.CodeK = LDebst.MWST
  451. AND Wust.CodeA = 99 NO-ERROR.
  452. iSprcd = bAdresse.Sprcd.
  453. IF bAufko.Adresse[05] <> '' THEN DO:
  454. DO ii = 1 TO 5:
  455. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'E',
  456. INPUT iZeile, INPUT bAufko.Adresse[ii] ).
  457. iZeile = iZeile + 1.
  458. END.
  459. END.
  460. ELSE DO:
  461. DO ii = 7 TO 11:
  462. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'E',
  463. INPUT iZeile, INPUT bAdresse.Anschrift[ii] ).
  464. iZeile = iZeile + 1.
  465. END.
  466. END.
  467. cDaten = STRING(dFakDatum,'99.99.9999').
  468. iZeile = iZeile + 2.
  469. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C',
  470. INPUT iZeile, INPUT cDaten ).
  471. iZeile = iZeile + 3.
  472. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C',
  473. INPUT iZeile, INPUT STRING(iFaknr,'>999999') ).
  474. iZeile = iZeile + 2.
  475. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C',
  476. INPUT iZeile, INPUT bAufko.U_Ref ).
  477. iZeile = 21.
  478. FOR EACH tAufze NO-LOCK
  479. BY tAufze.Aufnr
  480. BY tAufze.Sort1
  481. BY tAufze.LagOrt
  482. BY tAufze.Sort2
  483. BY tAufze.Pos :
  484. FIND Aufze NO-LOCK WHERE RECID(Aufze) = tAufze.Zeile.
  485. RUN ARTIKELZEILE ( RECID(tAufze) ).
  486. iZeile = iZeile + 1.
  487. nFakBetr = nFakBetr + Aufze.Net_Betr.
  488. RELEASE Aufze.
  489. END.
  490. iZeile = iZeile + 1.
  491. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D',
  492. INPUT iZeile, INPUT cFormText[13] ).
  493. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'I',
  494. INPUT iZeile, TRIM(STRING(nFakBetr,"->>>>9.99")) ).
  495. RUN SUMMENRABATTE.
  496. RUN GEBINDE_SALDO.
  497. RUN GEBINDE_ABRECHNUNG.
  498. RUN MEHRWERTSTEUER.
  499. iZeile = iZeile + 1.
  500. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D',
  501. INPUT iZeile, TRIM(SUBSTRING(cFormText[15],21,20)) ).
  502. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'I',
  503. INPUT iZeile, TRIM(STRING(nFakBetr,'->>>>>9.99')) ).
  504. iZeile = iZeile + 2.
  505. FIND Kondi USE-INDEX Kondi-k1
  506. WHERE Kondi.Kond = bAufko.Kond
  507. AND Kondi.Sprcd = iSprcd NO-LOCK NO-ERROR.
  508. IF AVAILABLE Kondi THEN DO:
  509. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D',
  510. INPUT iZeile, Kondi.Kotext ).
  511. END.
  512. DYNAMIC-FUNCTION('RELEASEEXCEL':U, INPUT hExcel ).
  513. END PROCEDURE.
  514. /* _UIB-CODE-BLOCK-END */
  515. &ANALYZE-RESUME
  516. &ENDIF
  517. &IF DEFINED(EXCLUDE-EXCEL_INIT) = 0 &THEN
  518. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE EXCEL_INIT Procedure
  519. PROCEDURE EXCEL_INIT :
  520. /*------------------------------------------------------------------------------
  521. Purpose:
  522. Parameters: <none>
  523. Notes:
  524. ------------------------------------------------------------------------------*/
  525. DEF VAR cVorlage AS CHAR NO-UNDO.
  526. DEF VAR lRetVal AS LOG NO-UNDO.
  527. FIND FIRST tParam.
  528. hExcel = DYNAMIC-FUNCTION('CREATEEXCEL':U) NO-ERROR.
  529. IF NOT VALID-HANDLE(hExcel) THEN RETURN 'ERROR'.
  530. cVorlage = tParam.Template + CHR(01) + tParam.Template.
  531. RUN CREATEDATEI ( INPUT cVorlage ).
  532. cVorlage = SESSION:TEMP-DIR + tParam.Template.
  533. RUN OPENEXCEL ( INPUT hExcel,
  534. INPUT cVorlage,
  535. INPUT '',
  536. OUTPUT lRetVal ).
  537. IF NOT lRetVal THEN DO:
  538. RUN RELEASEEXCEL ( INPUT hExcel ).
  539. RETURN 'ERROR'.
  540. END.
  541. RETURN ''.
  542. END PROCEDURE.
  543. /* _UIB-CODE-BLOCK-END */
  544. &ANALYZE-RESUME
  545. &ENDIF
  546. &IF DEFINED(EXCLUDE-FUELLEN_tAufze) = 0 &THEN
  547. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE FUELLEN_tAufze Procedure
  548. PROCEDURE FUELLEN_tAufze :
  549. /*------------------------------------------------------------------------------
  550. Purpose:
  551. Parameters: <none>
  552. Notes:
  553. ------------------------------------------------------------------------------*/
  554. DEF INPUT PARAMETER ipAufnr AS INT NO-UNDO.
  555. DEF VAR minPos AS INT NO-UNDO.
  556. DEF VAR maxPos AS INT NO-UNDO.
  557. DEF VAR jPlatz AS INT NO-UNDO.
  558. DEF VAR cLagOrt AS CHAR NO-UNDO.
  559. DEF VAR iRuestArt AS INT NO-UNDO.
  560. DEF VAR iPlusMinus AS INT NO-UNDO.
  561. DEF VAR lArtikel AS LOG NO-UNDO.
  562. EMPTY TEMP-TABLE tAufze.
  563. FIND Steuer NO-LOCK
  564. WHERE Steuer.Firma = cFirma NO-ERROR.
  565. IF AVAILABLE Steuer THEN iRuestArt = Steuer.RuestArt.
  566. ASSIGN minPos = 0
  567. maxPos = 9999
  568. iPlusMinus = 0.
  569. /* Kommentar zu Beginn eines Auftrages */
  570. lArtikel = FALSE.
  571. FOR EACH Aufze NO-LOCK
  572. WHERE Aufze.Firma = cFirma
  573. AND Aufze.Aufnr = ipAufnr
  574. AND Aufze.Pos > minPos:
  575. IF Aufze.Artnr > 0 THEN DO:
  576. lArtikel = TRUE.
  577. LEAVE.
  578. END.
  579. minPos = Aufze.Pos.
  580. CREATE tAufze.
  581. ASSIGN tAufze.Aufnr = Aufze.Aufnr
  582. tAufze.Artnr = Aufze.Artnr
  583. tAufze.Inhalt = Aufze.Inhalt
  584. tAufze.Jahr = Aufze.Jahr
  585. tAufze.Pos = Aufze.Pos
  586. tAufze.Zeile = RECID(Aufze)
  587. tAufze.Aktion = Aufze.Aktion
  588. tAufze.Preis = Aufze.Preis
  589. tAufze.MGeli = Aufze.MGeli
  590. tAufze.MRuek = Aufze.MRuek.
  591. ASSIGN tAufze.Sort1 = STRING(0,'99')
  592. tAufze.Sort2 = ''
  593. tAufze.Sort3 = STRING(tAufze.Artnr ,'999999')
  594. + STRING(tAufze.Inhalt,'9999')
  595. + STRING(tAufze.Jahr ,'9999')
  596. + STRING(iPlusMinus ,'9')
  597. + STRING(tAufze.Pos ,'99999').
  598. tAufze.LagOrt = ''.
  599. END.
  600. /* Kommentar am Ende eines Auftrages */
  601. IF lArtikel THEN DO:
  602. FOR EACH Aufze NO-LOCK
  603. WHERE Aufze.Firma = cFirma
  604. AND Aufze.Aufnr = ipAufnr
  605. BY Aufze.Pos DESCENDING:
  606. IF Aufze.Artnr > 0 THEN LEAVE.
  607. maxPos = Aufze.Pos.
  608. CREATE tAufze.
  609. ASSIGN tAufze.Aufnr = Aufze.Aufnr
  610. tAufze.Artnr = Aufze.Artnr
  611. tAufze.Inhalt = Aufze.Inhalt
  612. tAufze.Jahr = Aufze.Jahr
  613. tAufze.Pos = Aufze.Pos
  614. tAufze.Zeile = RECID(Aufze)
  615. tAufze.Aktion = Aufze.Aktion
  616. tAufze.Preis = Aufze.Preis
  617. tAufze.MGeli = Aufze.MGeli
  618. tAufze.MRuek = Aufze.MRuek.
  619. ASSIGN tAufze.Sort1 = STRING(0,'99')
  620. tAufze.Sort2 = ''
  621. tAufze.Sort3 = STRING(tAufze.Artnr ,'999999')
  622. + STRING(tAufze.Inhalt,'9999')
  623. + STRING(tAufze.Jahr ,'9999')
  624. + STRING(iPlusMinus ,'9')
  625. + STRING(tAufze.Pos ,'99999').
  626. tAufze.LagOrt = ''.
  627. END.
  628. END.
  629. /* Artikelzeilen nach Ruestplatz und Ort */
  630. cLagOrt = ''.
  631. FOR EACH Aufze NO-LOCK
  632. WHERE Aufze.Firma = cFirma
  633. AND Aufze.Aufnr = ipAufnr
  634. AND Aufze.Pos > minPos
  635. AND Aufze.Pos < MaxPos
  636. BY Aufze.Pos DESCENDING:
  637. IF Aufze.Artnr > 0 THEN DO:
  638. FIND ArtLager NO-LOCK
  639. WHERE ArtLager.Firma = Aufze.Firma
  640. AND ArtLager.Artnr = Aufze.Artnr
  641. AND ArtLager.Inhalt = Aufze.Inhalt
  642. AND ArtLager.Jahr = Aufze.Jahr
  643. AND ArtLager.Lager = Aufze.Lager.
  644. cLagOrt = ArtLager.Ort.
  645. END.
  646. iPlusMinus = (IF Aufze.MGeli < 0 THEN 1 ELSE 0).
  647. FIND LAST RuestPlatz USE-INDEX RuestPlatz-k2
  648. WHERE RuestPlatz.Firma = Aufze.Firma
  649. AND RuestPlatz.RuestArt = iRuestArt
  650. AND RuestPlatz.abLagOrt <= cLagOrt NO-ERROR.
  651. IF NOT AVAILABLE RuestPlatz THEN jPlatz = 90.
  652. ELSE jPlatz = RuestPlatz.Platz.
  653. CREATE tAufze.
  654. ASSIGN tAufze.Aufnr = Aufze.Aufnr
  655. tAufze.Artnr = Aufze.Artnr
  656. tAufze.Inhalt = Aufze.Inhalt
  657. tAufze.Jahr = Aufze.Jahr
  658. tAufze.Pos = Aufze.Pos
  659. tAufze.Zeile = RECID(Aufze)
  660. tAufze.Aktion = Aufze.Aktion
  661. tAufze.Preis = Aufze.Preis
  662. tAufze.MGeli = Aufze.MGeli
  663. tAufze.MRuek = Aufze.MRuek.
  664. ASSIGN tAufze.Sort1 = STRING(jPlatz,'99')
  665. tAufze.Sort2 = cLagOrt
  666. tAufze.Sort3 = STRING(tAufze.Artnr ,'999999')
  667. + STRING(tAufze.Inhalt,'9999')
  668. + STRING(tAufze.Jahr ,'9999')
  669. + STRING(iPlusMinus ,'9')
  670. + STRING(tAufze.Pos ,'99999').
  671. tAufze.LagOrt = cLagort.
  672. IF tAufze.Artnr > 0 AND
  673. tAufze.MGeli = 0 THEN DELETE tAufze.
  674. END.
  675. END PROCEDURE.
  676. /* _UIB-CODE-BLOCK-END */
  677. &ANALYZE-RESUME
  678. &ENDIF
  679. &IF DEFINED(EXCLUDE-GEBINDE_ABRECHNUNG) = 0 &THEN
  680. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE GEBINDE_ABRECHNUNG Procedure
  681. PROCEDURE GEBINDE_ABRECHNUNG :
  682. /*------------------------------------------------------------------------------
  683. Purpose:
  684. Parameters: <none>
  685. Notes:
  686. ------------------------------------------------------------------------------*/
  687. DEF VAR cDaten AS CHAR NO-UNDO.
  688. DEF VAR lTotal AS LOG NO-UNDO.
  689. DEF VAR nBetrag AS DEC NO-UNDO.
  690. DEF VAR i1 AS INT NO-UNDO.
  691. DEF VAR i2 AS INT NO-UNDO.
  692. DEF VAR iMwstCd AS INT NO-UNDO.
  693. DEF VAR nZTot AS DEC NO-UNDO.
  694. lTotal = FALSE.
  695. i2 = 0.
  696. nZTot = 0.
  697. FOR EACH AufGKon NO-LOCK
  698. WHERE AufGKon.Firma = BAufko.Firma
  699. AND AufGKon.Aufnr = BAufko.Aufnr
  700. AND AufGKon.Depot <> 0 :
  701. IF AufGKon.Eingang = 0 AND
  702. AufGKon.Ausgang = 0 THEN NEXT.
  703. IF i2 = 0 THEN iZeile = iZeile + 2.
  704. ELSE iZeile = iZeile + 1.
  705. FIND GebKonto NO-LOCK
  706. WHERE GebKonto.Firma = cFirma
  707. AND GebKonto.Geb_Cd = AufGKon.Geb_Cd.
  708. i1 = AufGKon.Ausgang.
  709. IF AufGKon.Depot = 0 AND
  710. AufGKon.Gebuehr = 0 THEN nBetrag = GebKonto.Depot + GebKonto.Gebuehr.
  711. ELSE nBetrag = AufGKon.Depot + AufGKon.Gebuehr.
  712. Rundbetr = i1 * nBetrag.
  713. iMwstCd = AufGKon.MWSt_Cd.
  714. nZTot = nZTot + Rundbetr.
  715. cDaten = GebKonto.Bez.
  716. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D',
  717. INPUT iZeile, INPUT cDaten ).
  718. cDaten = TRIM(STRING(AufGKon.Ausgang,"->>>>9")).
  719. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'C',
  720. INPUT iZeile, INPUT cDaten ).
  721. cDaten = TRIM(STRING(nBetrag,"->>>>9.999")).
  722. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'H',
  723. INPUT iZeile, INPUT cDaten ).
  724. cDaten = TRIM(STRING(Rundbetr,"->>>>9.999")).
  725. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'I',
  726. INPUT iZeile, INPUT cDaten ).
  727. cDaten = TRIM(STRING(iMwstCd,"z9")).
  728. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'J',
  729. INPUT iZeile, INPUT cDaten ).
  730. i2 = i2 + 1.
  731. END.
  732. IF i2 > 0 THEN lTotal = TRUE.
  733. IF lTotal THEN DO:
  734. iZeile = iZeile + 2.
  735. cDaten = TRIM(SUBSTRING(cFormText[11],21,20)).
  736. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D',
  737. INPUT iZeile, INPUT cDaten ).
  738. cdaten = TRIM(STRING(nZTot,"->>>>9.99")).
  739. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'I',
  740. INPUT iZeile, INPUT cDaten ).
  741. nFakBetr = nFakBetr + nZTot.
  742. END.
  743. iZeile = iZeile + 2.
  744. cDaten = TRIM(SUBSTRING(cFormText[15],21,20)).
  745. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D',
  746. INPUT iZeile, INPUT cDaten ).
  747. cDaten = TRIM(STRING(nFakBetr,"->>>>9.99")).
  748. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'I',
  749. INPUT iZeile, INPUT cDaten ).
  750. END PROCEDURE.
  751. /* _UIB-CODE-BLOCK-END */
  752. &ANALYZE-RESUME
  753. &ENDIF
  754. &IF DEFINED(EXCLUDE-GEBINDE_SALDO) = 0 &THEN
  755. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE GEBINDE_SALDO Procedure
  756. PROCEDURE GEBINDE_SALDO :
  757. /*------------------------------------------------------------------------------
  758. Purpose:
  759. Parameters: <none>
  760. Notes:
  761. ------------------------------------------------------------------------------*/
  762. FOR EACH AufGKon NO-LOCK
  763. WHERE AufGKon.Firma = BAufko.Firma
  764. AND AufGKon.Aufnr = BAufko.Aufnr
  765. AND AufGKon.Depot <> 0
  766. AND AufGKon.Betrag <> 0 :
  767. FIND FIRST tGebKto
  768. WHERE tGebKto.Geb_Cd = AufGKon.Geb_Cd NO-ERROR.
  769. IF NOT AVAILABLE tGebKto THEN DO:
  770. FIND GebKonto NO-LOCK
  771. WHERE GebKonto.Firma = AufGKon.Firma
  772. AND GebKonto.Geb_Cd = AufGKon.Geb_Cd .
  773. CREATE tGebKto.
  774. ASSIGN tGebKto.Sort_Cd = GebKonto.Sort_Cd
  775. tGebKto.Geb_Cd = GebKonto.Geb_Cd
  776. tGebKto.Bez = GebKonto.Bez
  777. tGebKto.Preis = AufGKon.Depot
  778. tGebKto.MWST_Cd = AufGKon.MWSt_Cd.
  779. END.
  780. tGebKto.A_Anz = tGebKto.A_Anz + AufGKon.Ausgang.
  781. tGebKto.A_Betrag = tGebKto.A_Anz * tGebKto.Preis.
  782. tGebKto.E_Anz = tGebKto.E_Anz + AufGKon.Eingang.
  783. tGebKto.E_Betrag = tGebKto.E_Anz * tGebKto.Preis.
  784. END.
  785. END PROCEDURE.
  786. /* _UIB-CODE-BLOCK-END */
  787. &ANALYZE-RESUME
  788. &ENDIF
  789. &IF DEFINED(EXCLUDE-MEHRWERTSTEUER) = 0 &THEN
  790. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE MEHRWERTSTEUER Procedure
  791. PROCEDURE MEHRWERTSTEUER :
  792. /*------------------------------------------------------------------------------
  793. Purpose:
  794. Parameters: <none>
  795. Notes:
  796. ------------------------------------------------------------------------------*/
  797. DEF VAR cDaten AS CHAR NO-UNDO.
  798. DEF VAR ix AS INT NO-UNDO.
  799. iZeile = iZeile + 1.
  800. DO ix = 1 TO 11:
  801. IF bAufko.Wpfl[ix] = 0 THEN NEXT.
  802. FIND LAST MWSTAns USE-INDEX MWSTAns-k1
  803. WHERE MWSTAns.MWST_Cd = ix
  804. AND MWSTAns.Datum <= BAUfko.Kond_Datum NO-LOCK.
  805. iZeile = iZeile + 1.
  806. cDaten = MWSTAns.Bez.
  807. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D',
  808. INPUT iZeile, INPUT cDaten ).
  809. cDaten = TRIM(STRING(bAufko.Wpfl[ix],"->>,>>9.99")).
  810. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'H',
  811. INPUT iZeile, INPUT cDaten ).
  812. cDaten = TRIM(STRING(bAufko.Wust[ix],"->>,>>9.99")).
  813. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'I',
  814. INPUT iZeile, INPUT cDaten ).
  815. cDaten = TRIM(STRING(ix,"z9")).
  816. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'J',
  817. INPUT iZeile, INPUT cDaten ).
  818. nFakBetr = nFakBetr + bAufko.Wust[ix].
  819. END.
  820. Rundbetr = nFakBetr.
  821. Rundcode = 1.
  822. RUN RUNDEN ( Rundcode, INPUT-OUTPUT Rundbetr ).
  823. nFakBetr = Rundbetr.
  824. iZeile = iZeile + 2.
  825. cDaten = TRIM(cFormText[16]).
  826. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D',
  827. INPUT iZeile, INPUT cDaten ).
  828. cDaten = TRIM(STRING(nFakBetr,"->>,>>9.99")).
  829. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'I',
  830. INPUT iZeile, INPUT cDaten ).
  831. END PROCEDURE.
  832. /* _UIB-CODE-BLOCK-END */
  833. &ANALYZE-RESUME
  834. &ENDIF
  835. &IF DEFINED(EXCLUDE-SUMMENRABATTE) = 0 &THEN
  836. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE SUMMENRABATTE Procedure
  837. PROCEDURE SUMMENRABATTE :
  838. /*------------------------------------------------------------------------------
  839. Purpose:
  840. Parameters: <none>
  841. Notes:
  842. ------------------------------------------------------------------------------*/
  843. DEF VAR RText AS CHAR FORMAT "x(20)" NO-UNDO.
  844. DEF VAR WText AS CHAR NO-UNDO.
  845. DEF VAR cDaten AS CHAR NO-UNDO.
  846. DEF VAR lTotal AS LOG NO-UNDO.
  847. DEF VAR lRabatt AS LOG NO-UNDO.
  848. DEF VAR iPlus AS INT NO-UNDO.
  849. DEF VAR nRabWert AS DEC NO-UNDO.
  850. DEF VAR iMwstCd AS INT NO-UNDO.
  851. /* Auftragsrabatt ---------------------------------------------------- */
  852. lTotal = FALSE.
  853. iPlus = 0.
  854. FOR EACH tRabSumm
  855. WHERE tRabSumm.Auf_Rab <> 0
  856. BY tRabSumm.Rab_Summ:
  857. Rundbetr = tRabSumm.Auf_Rab.
  858. nFakBetr = nFakBetr - Rundbetr.
  859. IF NOT lRabatt THEN NEXT.
  860. IF iPlus = 0 THEN iZeile = iZeile + 2.
  861. ELSE iZeile = iZeile + 1.
  862. IF Rundbetr < 0 THEN RText = cZusText.
  863. ELSE RText = cRabText.
  864. FIND FIRST AufRabSu NO-LOCK USE-INDEX AufRabSu-k1
  865. WHERE AufRabSu.Firma = bAufko.Firma
  866. AND AufRabSu.Aufnr = bAufko.Aufnr
  867. AND AufRabSu.Rab_Summ = tRabSumm.Rab_Summ.
  868. IF AufRabSu.F_Proz_Betr THEN WText = "%".
  869. ELSE WText = "Fr.".
  870. nRabWert = ABSOLUT(AufRabSu.F_Wert).
  871. cDaten = RText
  872. + " "
  873. + tRabSumm.Bez
  874. + " "
  875. + STRING(nRabWert,"z9.99- ")
  876. + WText.
  877. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D',
  878. INPUT iZeile, INPUT cDaten ).
  879. cDaten = STRING(- Rundbetr,"->>>>9.99").
  880. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'I',
  881. INPUT iZeile, INPUT cDaten ).
  882. iPlus = iPlus + 1.
  883. END.
  884. IF iPlus > 0 THEN lTotal = TRUE.
  885. /* Abholrabatt ------------------------------------------------------- */
  886. iPlus = 0.
  887. FOR EACH tRabSumm
  888. WHERE tRabSumm.Abh_Rab <> 0
  889. BY tRabSumm.Rab_Summ:
  890. Rundbetr = tRabSumm.Abh_Rab.
  891. nFakBetr = nFakBetr - Rundbetr.
  892. IF NOT lRabatt THEN NEXT.
  893. IF iPlus = 0 THEN iZeile = iZeile + 2.
  894. ELSE iZeile = iZeile + 1.
  895. IF Rundbetr < 0 THEN RText = cZusText.
  896. ELSE RText = cRabText.
  897. FIND FIRST AufRabSu NO-LOCK USE-INDEX AufRabSu-k1
  898. WHERE AufRabSu.Firma = bAufko.Firma
  899. AND AufRabSu.Aufnr = bAufko.Aufnr
  900. AND AufRabSu.Rab_Summ = tRabSumm.Rab_Summ.
  901. IF AufRabSu.A_Proz_Betr THEN WText = "%".
  902. ELSE WText = "Fr.".
  903. nRabWert = ABSOLUT(AufRabSu.A_Wert).
  904. cDaten = RText
  905. + " "
  906. + tRabSumm.Bez
  907. + " "
  908. + STRING(nRabWert,"z9.99- ")
  909. + WText.
  910. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D',
  911. INPUT iZeile, INPUT cDaten ).
  912. cDaten = STRING(- Rundbetr,"->>>>9.99").
  913. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'I',
  914. INPUT iZeile, INPUT cDaten ).
  915. iPlus = iPlus + 1.
  916. END.
  917. IF iPlus > 0 THEN lTotal = TRUE.
  918. /* Spezialpreis-Auftragsrabatte ---------------------------------------- */
  919. iPlus = 0.
  920. FOR EACH tSpeRab
  921. WHERE tSpeRab.Auf_Betr <> 0
  922. BY tSpeRab.Rab_Grp:
  923. Rundbetr = tSpeRab.Auf_Betr.
  924. nFakBetr = nFakBetr - Rundbetr.
  925. IF NOT lRabatt THEN NEXT.
  926. IF iPlus = 0 THEN iZeile = iZeile + 2.
  927. ELSE iZeile = iZeile + 1.
  928. IF Rundbetr < 0 THEN RText = cZusText.
  929. ELSE RText = cRabText.
  930. FIND Tabel NO-LOCK
  931. WHERE Tabel.Firma = cFirma
  932. AND Tabel.RecArt = 'ARABGRP'
  933. AND Tabel.CodeC = ''
  934. AND Tabel.CodeI = tSpeRab.Rab_Grp
  935. AND Tabel.Sprcd = 1 .
  936. FIND FIRST AufSpRab NO-LOCK
  937. WHERE AufSpRab.Firma = bAufko.Firma
  938. AND AufSpRab.Aufnr = bAufko.Aufnr
  939. AND AufSpRab.Rab_Grp = tSpeRab.Rab_Grp.
  940. IF AufSpRab.Auf_Proz_Betr THEN WText = "%".
  941. ELSE WText = "Fr.".
  942. nRabWert = ABSOLUT(AufSpRab.Auf_Wert).
  943. cDaten = RText
  944. + " "
  945. + tRabSumm.Bez
  946. + " "
  947. + STRING(nRabWert,"z9.99- ")
  948. + WText.
  949. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D',
  950. INPUT iZeile, INPUT cDaten ).
  951. cDaten = STRING(- Rundbetr,"->>>>9.99").
  952. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'I',
  953. INPUT iZeile, INPUT cDaten ).
  954. iPlus = iPlus + 1.
  955. END.
  956. IF iPlus > 0 THEN lTotal = TRUE.
  957. IF lTotal THEN DO:
  958. iZeile = iZeile + 1.
  959. cDaten = TRIM(SUBSTRING(cFormText[14],21,20)).
  960. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D',
  961. INPUT iZeile, INPUT cDaten ).
  962. cDaten = TRIM(STRING(nFakBetr,"->>>>9.99")).
  963. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'I',
  964. INPUT iZeile, INPUT cDaten ).
  965. END.
  966. /* Recycling-Gebühren ------------------------------------------------ */
  967. lTotal = FALSE.
  968. iPlus = 0.
  969. FOR EACH AufGKon NO-LOCK
  970. WHERE AufGKon.Firma = bAufko.Firma
  971. AND AufGKon.Aufnr = bAufko.Aufnr
  972. AND AufGKon.Gebuehr <> 0
  973. AND AufGKon.Betrag <> 0 :
  974. nFakBetr = nFakBetr + AufGKon.Betrag.
  975. IF NOT lRabatt THEN NEXT.
  976. IF iPlus = 0 THEN iZeile = iZeile + 2.
  977. ELSE iZeile = iZeile + 1.
  978. iMwstCd = AufGKon.MWSt_Cd.
  979. FIND GebKonto OF AufGKon NO-LOCK NO-ERROR.
  980. IF NOT AVAILABLE GebKonto THEN cDaten = TRIM(SUBSTRING(cFormText[11],41,20)).
  981. ELSE cDaten = GebKonto.Bez.
  982. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D',
  983. INPUT iZeile, INPUT cDaten ).
  984. cDaten = TRIM(STRING(AufGKon.Ausgang,"->>>>>9")).
  985. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'H',
  986. INPUT iZeile, INPUT cDaten ).
  987. cDaten = TRIM(STRING(AufGKon.Betrag,"->>>>9.99")).
  988. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'I',
  989. INPUT iZeile, INPUT cDaten ).
  990. cDaten = TRIM(STRING(AufGKon.MWSt_Cd ,"z9")).
  991. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'J',
  992. INPUT iZeile, INPUT cDaten ).
  993. iPlus = iPlus + 1.
  994. END.
  995. IF iPlus > 0 THEN lTotal = TRUE.
  996. IF lTotal THEN DO:
  997. iZeile = iZeile + 1.
  998. cDaten = TRIM(SUBSTRING(cFormText[14],21,20)).
  999. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'D',
  1000. INPUT iZeile, INPUT cDaten ).
  1001. cDaten = TRIM(STRING(nFakBetr,"->>>>9.99")).
  1002. RUN ZELLEFUELLEN ( INPUT hExcel, INPUT 'I',
  1003. INPUT iZeile, INPUT cDaten ).
  1004. END.
  1005. END PROCEDURE.
  1006. /* _UIB-CODE-BLOCK-END */
  1007. &ANALYZE-RESUME
  1008. &ENDIF