API tools faq
paste
Advertisement
Dece111

Prd Esterna

Dece111
Feb 28th, 2024
111
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VisualBasic 19.97 KB | None | 0 0
raw download clone embed print report diff
  1. Prd Esterna
  2.  
  3. Dim STR_RIGA(1000, 11) As String
  4. 'Dim codfnl(2000, 2) As String
  5. Dim COD_WRITE(2000, 2) As String
  6.  
  7. Sub EXTERNAL_PROD()
  8.  
  9.  
  10.  
  11. 'STR_DXF = "+"
  12. '
  13. ''****************************FAI I DXF CHE NON ESISTONO
  14. 'For NFGG = 1 To NM_DT
  15. '
  16. 'If INFO_DAT(NFGG, 0, 23) > 0 And INFO_DAT(NFGG, 0, 28) = 0 And INFO_DAT(NFGG, 0, 11) = "1.8" Then GoTo FAI_DXF
  17. 'If INFO_DAT(NFGG, 0, 23) > 0 And INFO_DAT(NFGG, 0, 29) = 0 And INFO_DAT(NFGG, 0, 11) = "1.5" Then
  18. '
  19. 'FAI_DXF:
  20. 'If InStr(1, STR_DXF, INFO_DAT(NFGG, 0, 16)) = 0 Then
  21. 'Call MODEL_SUB(NFGG, 2)
  22. 'Call READ_DXF(OUTPUT_FOLDER & Right(INFO_DAT(NFGG, 0, 3), 13) & ".DXF", NFGG)
  23. 'STR_DXF = STR_DXF & "+" & INFO_DAT(NFGG, 0, 16) & "+"
  24. 'If INFO_DAT(NFGG, 0, 11) = "1.8" Then FileCopy OUTPUT_FOLDER & Right(INFO_DAT(NFGG, 0, 3), 13) & ".DXF", DXF_ANTE_18 & Right(INFO_DAT(NFGG, 0, 3), 13) & ".DXF" 'DA TESTARE
  25. 'If INFO_DAT(NFGG, 0, 11) = "1.5" Then FileCopy OUTPUT_FOLDER & Right(INFO_DAT(NFGG, 0, 3), 13) & ".DXF", DXF_ANTE_15 & Right(INFO_DAT(NFGG, 0, 3), 13) & ".DXF" 'DA TESTARE
  26. '
  27. 'End If
  28. 'End If
  29. 'Next NFGG
  30. ''*****************************************************
  31.  
  32.  
  33. Call WRITE_REPORT 'SCRIVO IL REPORT PER LA PRODUZINE ESTERNA
  34.  
  35.  
  36. End Sub
  37.  
  38.  
  39. Sub WRITE_REPORT() 'CREAZIONE REPORT PER PRODUZIONE ESTERNA
  40.  
  41.  
  42. ''Call upld_fnl_ante 'CARICA I CODICI
  43.  
  44.  
  45. KJ = 0
  46.  
  47. For RP = 1 To 2
  48.  
  49. 'For WW = 1 To 2
  50.  
  51. 'Select Case WW
  52. 'Case 1
  53. 'PRG_AVL = "_1_2_3_"
  54. 'Case 2
  55. 'PRG_AVL = "_4_5_"
  56. 'End Select
  57.  
  58. PRIMO_PRG = ""
  59. PRG_TOT2 = ""
  60. For PT = 1 To 5
  61. If PRG_NUM(PT) = "" Then Exit For
  62. 'If InStr(PRG_AVL, Right(PRG_NUM(PT), 1)) > 0 Then
  63. If PRIMO_PRG = "" Then
  64. PRIMO_PRG = PRG_NUM(PT)
  65. PRG_TOT2 = PRIMO_PRG
  66. Else
  67. PRG_TOT2 = PRIMO_PRG & PRG_NUM(PT)
  68. End If
  69. 'End If
  70. Next PT
  71. PRG_TOT2 = Replace(PRG_TOT2, "-", "")
  72.  
  73.  
  74.  
  75. If PRG_TOT2 <> "" Then
  76. For NM = 1 To NN_MAT 'MATERIALE
  77. Erase STR_RIGA
  78.  
  79. If RP = 2 Then SUFF = "_4AN" Else SUFF = "_2AN"
  80. NAMEFL = "FNL-" & PRG_TOT2 & "-" & Replace(STR_MTR(NM), " ", "") & "-OS" & SUFF & ".xlsx"
  81. NAMEFLPTH = OUTPUT_FOLDER & NAMEFL
  82. 'FINO QUA PER DARE IL TITOLO
  83.  
  84.  
  85. If Len(Dir(NAMEFLPTH)) > 0 Then Kill NAMEFLPTH
  86. Dim wb As Workbook
  87. Set wb = Workbooks.Add()
  88. wb.SaveAs fileName:=NAMEFLPTH
  89. Workbooks.Open fileName:=NAMEFLPTH
  90.  
  91. Cells(1 + 1, 1) = "MATERIALE"
  92. Cells(1 + 1, 2) = "QTOT"
  93. Cells(1 + 1, 3) = "COD"
  94. Cells(1 + 1, 4) = "Controllo"
  95. Cells(1 + 1, 5) = "ALS"
  96. Cells(1 + 1, 6) = "AVS"
  97. Cells(1 + 1, 7) = "AVD"
  98. Cells(1 + 1, 8) = "ALD"
  99. Cells(1 + 1, 9) = "COMMESSA"
  100. Cells(1 + 1, 10) = "COD PROG"
  101. Cells(1 + 1, 11) = "Omega"
  102. Cells(1 + 1, 12) = "SEQ"
  103.  
  104. 'Cells(1, 11) = "TURNO"
  105. Columns("I:I").NumberFormat = "@"
  106. Columns("J:J").NumberFormat = "@"
  107.  
  108. Columns("A:A").ColumnWidth = 12
  109. Columns("B:B").ColumnWidth = 6.5
  110. Columns("C:C").ColumnWidth = 18
  111. Columns("D:D").ColumnWidth = 10
  112. Columns("E:E").ColumnWidth = 8
  113. Columns("F:F").ColumnWidth = 8
  114. Columns("G:G").ColumnWidth = 8
  115. Columns("H:H").ColumnWidth = 8
  116. Columns("I:I").ColumnWidth = 30
  117. Columns("J:J").ColumnWidth = 12
  118. Columns("K:K").ColumnWidth = 8
  119.  
  120.     Columns("H:H").Select
  121.     With Selection
  122.         .HorizontalAlignment = xlCenter
  123.         .VerticalAlignment = xlBottom
  124.         .WrapText = False
  125.         .Orientation = 0
  126.         .AddIndent = False
  127.         .IndentLevel = 0
  128.         .ShrinkToFit = False
  129.         .ReadingOrder = xlContext
  130.         .MergeCells = False
  131.     End With
  132.  
  133.  
  134. Cells(2, 1).Select
  135. ActiveCell.Select
  136.     With Selection
  137.         .HorizontalAlignment = xlLeft
  138.         .VerticalAlignment = xlBottom
  139.         .WrapText = False
  140.         .Orientation = 0
  141.         .AddIndent = False
  142.         .ShrinkToFit = False
  143.         .MergeCells = False
  144.     End With
  145.        
  146.     With ActiveSheet.PageSetup
  147.         .PrintTitleRows = ""
  148.         .PrintTitleColumns = ""
  149.     End With
  150.     ActiveSheet.PageSetup.PrintArea = ""
  151.     With ActiveSheet.PageSetup
  152.         .LeftHeader = "PROGRAMMA FNL-" & STR_MTR(NM) & "-OS" & SUFF & " FORNITURA ESTERNA"
  153.         .CenterHeader = ""
  154.         .RightHeader = "Doc 1.SK.U.STM501"
  155.         .LeftFooter = "&F"
  156.         .CenterFooter = ""
  157.         .RightFooter = "Pag. " & "&P" & " \ " & "&N"
  158.         .LeftMargin = Application.InchesToPoints(0.33)
  159.         .RightMargin = Application.InchesToPoints(0.33)
  160.         .TopMargin = Application.InchesToPoints(0.38)
  161.         .BottomMargin = Application.InchesToPoints(0.44)
  162.         .HeaderMargin = Application.InchesToPoints(0.17)
  163.         .FooterMargin = Application.InchesToPoints(0.2)
  164.         .PrintHeadings = False
  165.         .PrintGridlines = False
  166.         .PrintComments = xlPrintNoComments
  167.         .CenterHorizontally = False
  168.         .CenterVertically = False
  169.         .Orientation = xlLandscape
  170.         .Draft = False
  171.         .PaperSize = xlPaperA4
  172.         .FirstPageNumber = xlAutomatic
  173.         .Order = xlDownThenOver
  174.         .BlackAndWhite = False
  175.         .Zoom = 80
  176.     End With
  177.  
  178.  
  179.  
  180.  
  181. For NN = 1 To NN_CODE 'COMMESSE ANTE
  182. For I3 = 1 To 1000 'NUMERO DATI GESTITI
  183.  
  184. 'If InStr(1, PRG_AVL, Right(INFO_DAT(I3, 0, 0), 1)) > 0 Then 'NUMERO PROGRAMMA
  185. If INFO_DAT(I3, 0, 25) = STR_MTR(NM) Then
  186. If INFO_DAT(I3, 0, 2) = STR_COD(NN) And INFO_DAT(I3, 0, 23) > 0 Then
  187.  
  188. STR_RIGA(NN, 3) = INFO_DAT(I3, 0, 24) 'CODICE ANTE
  189. STR_RIGA(NN, 1) = INFO_DAT(I3, 0, 25) 'CODICE MATERIALE
  190.  
  191.  
  192. STR_RIGA(NN, 3 + INFO_DAT(I3, 0, 23)) = INFO_DAT(I3, 0, 26) & Chr(10) & Chr(13) & INFO_DAT(I3, 0, 13) & "x" & Round(Val(INFO_DAT(I3, 0, 12)), 0)  'CODICE RAGGRUPPAMENTO
  193. STR_RIGA(NN, 2) = Val(INFO_DAT(I3, 0, 4)) 'QUANTITà
  194. STR_RIGA(NN, 8) = INFO_DAT(I3, 0, 2) 'COMMESSA
  195. STR_RIGA(NN, 9) = INFO_DAT(I3, 0, 32) 'PRG
  196. STR_RIGA(NN, 10) = INFO_DAT(I3, 0, 36) 'SHIFT
  197. STR_RIGA(NN, 11) = INFO_DAT(I3, 0, 6) 'CODICE DISEGNO
  198. ''If InStr(1, STR_RIGA(NN, 8), INFO_DAT(I3, 0, 2)) = 0 Then
  199. ''STR_RIGA(NN, 8) = STR_RIGA(NN, 8) & " " & INFO_DAT(I3, 0, 2) & "-" & INFO_DAT(I3, 0, 4) 'COMMESSE + QUANTITà
  200. ''STR_RIGA(NN, 2) = Val(STR_RIGA(NN, 2)) + Val(INFO_DAT(I3, 0, 4)) 'QUANTITà
  201. ''End If
  202.  
  203. End If
  204. 'End If
  205. End If
  206.  
  207. Next I3
  208. Next NN
  209. ''''*******************************************************************************
  210.  
  211. ''For RR2 = 1 To NN_CODE 'SOMMA COMMESSE UGUALI
  212. ''For RR3 = 1 + RR2 To NN_CODE
  213. ''
  214. ''If STR_RIGA(RR2, 4) = STR_RIGA(RR3, 4) And STR_RIGA(RR2, 5) = STR_RIGA(RR3, 5) And STR_RIGA(RR2, 6) = STR_RIGA(RR3, 6) And STR_RIGA(RR2, 7) = STR_RIGA(RR3, 7) Then
  215. ''
  216. ''STR_RIGA(RR2, 2) = Val(STR_RIGA(RR2, 2)) + Val(STR_RIGA(RR3, 2))
  217. ''STR_RIGA(RR2, 8) = STR_RIGA(RR2, 8) & "  " & STR_RIGA(RR3, 8)
  218. ''
  219. ''STR_RIGA(RR3, 1) = ""
  220. ''STR_RIGA(RR3, 2) = ""
  221. ''STR_RIGA(RR3, 3) = ""
  222. ''STR_RIGA(RR3, 4) = ""
  223. ''STR_RIGA(RR3, 5) = ""
  224. ''STR_RIGA(RR3, 6) = ""
  225. ''STR_RIGA(RR3, 7) = ""
  226. ''STR_RIGA(RR3, 8) = ""
  227. ''Else
  228. ''Exit For
  229. ''End If
  230. ''Next RR3
  231. ''Next RR2
  232.  
  233. ''''*******************************************************************************
  234.  
  235. RR = 1 ' 0
  236. ''For SH = 2 To 1 Step -1
  237. 'For SQ = 300 To 1 Step -1
  238. For SQ = 1 To 300
  239. For NN1 = 1 To UBound(STR_RIGA)
  240.  
  241. ''If Val(STR_RIGA(NN1, 10)) = SH Then
  242. If Val(STR_RIGA(NN1, 9)) = SQ Then
  243. If STR_RIGA(NN1, 3) <> "" Then
  244.  
  245. RR = RR + 1
  246. Cells(RR + 1, 1) = STR_RIGA(NN1, 1)
  247. Cells(RR + 1, 2) = STR_RIGA(NN1, 2)
  248. Cells(RR + 1, 3) = STR_RIGA(NN1, 3)
  249. Cells(RR + 1, 4 + 1) = STR_RIGA(NN1, 4)
  250. Cells(RR + 1, 5 + 1) = STR_RIGA(NN1, 5)
  251. Cells(RR + 1, 6 + 1) = STR_RIGA(NN1, 6)
  252. Cells(RR + 1, 7 + 1) = STR_RIGA(NN1, 7)
  253. Cells(RR + 1, 8 + 1) = STR_RIGA(NN1, 8)
  254. If InStr(1, comm_omg_spc, STR_RIGA(NN1, 8)) > 0 Then
  255. Cells(RR + 1, 10 + 1) = "SI"
  256. End If
  257. Cells(RR + 1, 12) = STR_RIGA(NN1, 9)
  258. Cells(RR + 1, 9 + 1) = COD_PIEGA(STR_RIGA(NN1, 3), STR_RIGA(NN1, 11))
  259.  
  260.  
  261. 'Cells(RR + 1, 11) = STR_RIGA(NN1, 10)
  262.  
  263. '''''**************************************************************GENERO IL NUOVO CODICE DI IDENTIFICAZIONE
  264. ''''VVV = Cells(RR + 1, 4 + 1) & Cells(RR + 1, 5 + 1) & Cells(RR + 1, 6 + 1) & Cells(RR + 1, 7 + 1)
  265. ''''
  266. ''''
  267. ''''If Cells(RR + 1, 4 + 1) = "" Then
  268. ''''CC1 = "N"
  269. ''''Else
  270. ''''CC1 = Right(Cells(RR + 1, 4 + 1), 2)
  271. ''''End If
  272. ''''If Cells(RR + 1, 5 + 1) = "" Then
  273. ''''CC2 = "N"
  274. ''''Else
  275. ''''CC2 = Right(Cells(RR + 1, 5 + 1), 2)
  276. ''''End If
  277. ''''If Cells(RR + 1, 6 + 1) = "" Then
  278. ''''CC3 = "N"
  279. ''''Else
  280. ''''CC3 = Right(Cells(RR + 1, 6 + 1), 2)
  281. ''''End If
  282. ''''If Cells(RR + 1, 7 + 1) = "" Then
  283. ''''CC4 = "N"
  284. ''''Else
  285. ''''CC4 = Right(Cells(RR + 1, 7 + 1), 2)
  286. ''''End If
  287. ''''CCC = CC1 & CC2 & CC3 & CC4
  288. ''''
  289. ''''
  290. ''''NUM_CC = quanteVolte(CCC, "N")
  291. ''''Select Case NUM_CC
  292. ''''Case Is >= 2
  293. ''''If Cells(RR + 1, 4 + 1) = "" Then
  294. ''''CC1 = "N"
  295. ''''Else
  296. ''''CC1 = Right(Cells(RR + 1, 4 + 1), 3)
  297. ''''End If
  298. ''''If Cells(RR + 1, 5 + 1) = "" Then
  299. ''''CC2 = "N"
  300. ''''Else
  301. ''''CC2 = Right(Cells(RR + 1, 5 + 1), 3)
  302. ''''End If
  303. ''''If Cells(RR + 1, 6 + 1) = "" Then
  304. ''''CC3 = "N"
  305. ''''Else
  306. ''''CC3 = Right(Cells(RR + 1, 6 + 1), 3)
  307. ''''End If
  308. ''''If Cells(RR + 1, 7 + 1) = "" Then
  309. ''''CC4 = "N"
  310. ''''Else
  311. ''''CC4 = Right(Cells(RR + 1, 7 + 1), 3)
  312. ''''End If
  313. ''''CCC = CC1 & CC2 & CC3 & CC4
  314. ''''Case Is < 2
  315. ''''
  316. ''''CCC = CCC
  317. ''''End Select
  318. ''''
  319. '''''************************************CODICI DOPPI
  320. ''''If Cells(RR + 1, 4 + 1) & Cells(RR + 1, 5 + 1) & Cells(RR + 1, 6 + 1) & Cells(RR + 1, 7 + 1) = "722514926051830524724342" Then CCC = "14512442B"
  321. ''''If Cells(RR + 1, 4 + 1) & Cells(RR + 1, 5 + 1) & Cells(RR + 1, 6 + 1) & Cells(RR + 1, 7 + 1) = "724715830357935190722817" Then CCC = "15579017B"
  322. ''''If Cells(RR + 1, 4 + 1) & Cells(RR + 1, 5 + 1) & Cells(RR + 1, 6 + 1) & Cells(RR + 1, 7 + 1) = "714655945755945756714657" Then CCC = "55555657B"
  323. ''''If Cells(RR + 1, 4 + 1) & Cells(RR + 1, 5 + 1) & Cells(RR + 1, 6 + 1) & Cells(RR + 1, 7 + 1) = "1022660102265910241651022429" Then CCC = "60596529B"
  324. ''''If Cells(RR + 1, 4 + 1) & Cells(RR + 1, 5 + 1) & Cells(RR + 1, 6 + 1) & Cells(RR + 1, 7 + 1) = "1021337102133510213361021338" Then CCC = "37353638B"
  325. ''''If Cells(RR + 1, 4 + 1) & Cells(RR + 1, 5 + 1) & Cells(RR + 1, 6 + 1) & Cells(RR + 1, 7 + 1) = "830531830533" Then CCC = "NN531533B"
  326. ''''If Cells(RR + 1, 4 + 1) & Cells(RR + 1, 5 + 1) & Cells(RR + 1, 6 + 1) & Cells(RR + 1, 7 + 1) = "1022402102240110224001022403" Then CCC = "02010003B"
  327. ''''If Cells(RR + 1, 4 + 1) & Cells(RR + 1, 5 + 1) & Cells(RR + 1, 6 + 1) & Cells(RR + 1, 7 + 1) = "1021337102553610213361021338" Then CCC = "37363638B"
  328. '''''************************************************
  329. ''''Cells(RR + 1, 9 + 1) = CCC
  330. ''''
  331. ''''
  332. ''''
  333. ''''ATT = 0
  334. ''''For G1 = 1 To Val(codfnl(0, 0))
  335. ''''If CCC = codfnl(G1, 1) Then
  336. ''''If VVV = codfnl(G1, 2) Then
  337. ''''ATT = 1
  338. ''''Else
  339. ''''MsgBox ("ATTENZIONE CODICE PROGRAMMA " & CCC & " DOPPIO, NOMINARLO DIVERSAMENTE")
  340. ''''End If
  341. ''''End If
  342. ''''Next G1
  343. ''''
  344. ''''If ATT = 0 Then
  345. ''''KJ = KJ + 1
  346. ''''COD_WRITE(KJ, 1) = CCC
  347. ''''COD_WRITE(KJ, 2) = VVV
  348. ''''End If
  349.  
  350. '**********************************************************************************************
  351. End If
  352. End If
  353. 'End If
  354. Next NN1
  355. Next SQ
  356. ''Next SH
  357.  
  358.  
  359.  
  360. For RR2 = 2 To NN_CODE 'SOMMA COMMESSE UGUALI
  361. For RR3 = 1 + RR2 To NN_CODE
  362.  
  363. If Cells(RR2, 4 + 1) = Cells(RR3, 4 + 1) And Cells(RR2, 5 + 1) = Cells(RR3, 5 + 1) And Cells(RR2, 6 + 1) = Cells(RR3, 6 + 1) And Cells(RR2, 7 + 1) = Cells(RR3, 7 + 1) And Cells(RR2, 10 + 1) = Cells(RR3, 10 + 1) Then
  364.  
  365. Cells(RR2, 2) = Val(Cells(RR2, 2)) + Val(Cells(RR3, 2))
  366. Cells(RR2, 8 + 1) = Cells(RR2, 8 + 1) & "  " & Cells(RR3, 8 + 1)
  367.  
  368. Cells(RR3, 1) = ""
  369. Cells(RR3, 2) = ""
  370. Cells(RR3, 3) = ""
  371. Cells(RR3, 4) = ""
  372. Cells(RR3, 5) = ""
  373. Cells(RR3, 6) = ""
  374. Cells(RR3, 7) = ""
  375. Cells(RR3, 8) = ""
  376. Cells(RR3, 9) = ""
  377. Cells(RR3, 10) = ""
  378. Cells(RR3, 11) = ""
  379. Cells(RR3, 12) = ""
  380.  
  381. Else
  382. Exit For
  383. End If
  384. Next RR3
  385. Next RR2
  386.  
  387.  
  388.  
  389.  
  390.  
  391. 'CANCELLA LE RIGHE VUOTE
  392. CANC_RIGA:
  393. For N1 = 1 To NN
  394. If Cells(N1 + 1, 3) = "" Then
  395. Rows(N1 + 1).Delete
  396. NN = NN - 1
  397. GoTo CANC_RIGA
  398. End If
  399. Next N1
  400. '************************
  401.  
  402.  
  403. '*******************************METTE LE DUE ANTE PER ULTIME
  404. Dim cll(200, 12) As String
  405.  
  406. N4 = 0
  407. Erase cll
  408. CANC_RIGA2:
  409. For N1 = 1 To 100
  410. If Cells(N1 + 1, 1) <> "" Then
  411. If Cells(N1 + 1, 4 + 1) = "" Or Cells(N1 + 1, 5 + 1) = "" Or Cells(N1 + 1, 6 + 1) = "" Or Cells(N1 + 1, 7 + 1) = "" Then
  412. N4 = N4 + 1
  413. cll(N4, 1) = Cells(N1 + 1, 1)
  414. cll(N4, 2) = Cells(N1 + 1, 2)
  415. cll(N4, 3) = Cells(N1 + 1, 3)
  416. cll(N4, 4) = Cells(N1 + 1, 4)
  417. cll(N4, 5) = Cells(N1 + 1, 5)
  418. cll(N4, 6) = Cells(N1 + 1, 6)
  419. cll(N4, 7) = Cells(N1 + 1, 7)
  420. cll(N4, 8) = Cells(N1 + 1, 8)
  421. cll(N4, 9) = Cells(N1 + 1, 9)
  422. cll(N4, 10) = Cells(N1 + 1, 10)
  423. cll(N4, 11) = Cells(N1 + 1, 11)
  424. cll(N4, 12) = Cells(N1 + 1, 12)
  425.  
  426. Rows(N1 + 1).Delete
  427. GoTo CANC_RIGA2
  428. End If
  429. End If
  430. Next N1
  431.  
  432.  
  433.  
  434. n5 = 0
  435. For N2 = 1 To 150
  436.  
  437. If Cells(N2 + 1, 1) = "" Then
  438. n5 = n5 + 1
  439. If cll(n5, 1) = "" Then Exit For
  440. Cells(N2 + 1, 1) = cll(n5, 1)
  441. Cells(N2 + 1, 2) = cll(n5, 2)
  442. Cells(N2 + 1, 3) = cll(n5, 3)
  443. Cells(N2 + 1, 4) = cll(n5, 4)
  444. Cells(N2 + 1, 5) = cll(n5, 5)
  445. Cells(N2 + 1, 6) = cll(n5, 6)
  446. Cells(N2 + 1, 7) = cll(n5, 7)
  447. Cells(N2 + 1, 8) = cll(n5, 8)
  448. Cells(N2 + 1, 9) = cll(n5, 9)
  449. Cells(N2 + 1, 10) = cll(n5, 10)
  450. Cells(N2 + 1, 11) = cll(n5, 11)
  451. Cells(N2 + 1, 12) = cll(n5, 12)
  452. End If
  453.  
  454. Next N2
  455. '**********************************************
  456.  
  457. If RP = 2 Then
  458. CANC_RIGA22:
  459. For N1 = 2 To 200
  460. If Cells(N1 + 1, 1) <> "" Then
  461. If Cells(N1 + 1, 5) = "" Or Cells(N1 + 1, 6) = "" Or Cells(N1 + 1, 7) = "" Or Cells(N1 + 1, 8) = "" Then
  462. Rows(N1 + 1).Delete
  463. GoTo CANC_RIGA22
  464. End If
  465. End If
  466. Next N1
  467. End If
  468.  
  469.  
  470. If RP = 1 Then 'PER CANCELLARE LE RIGHE RELATIVE ALLE 4 ANTE
  471. CANC_RIGA3:
  472. For N1 = 2 To 200
  473. If Cells(N1 + 1, 1) <> "" Then
  474. If Cells(N1 + 1, 5) <> "" And Cells(N1 + 1, 6) <> "" And Cells(N1 + 1, 7) <> "" And Cells(N1 + 1, 8) <> "" Then
  475. Rows(N1 + 1).Delete
  476. GoTo CANC_RIGA3
  477. End If
  478. End If
  479. Next N1
  480. End If
  481.  
  482.  
  483.  
  484. RRW = NN + 1
  485.  
  486.  
  487. '************AGGIUNGO I GIORNI
  488. 'For DG = 2 To RRW
  489. 'GIORNI_FNL = PRG_NUM(1) 'Replace(PRG_AVL, "_", "-")
  490. ''GIORNI_FNL = Right(GIORNI_FNL, Len(GIORNI_FNL) - 1)
  491. ''GIORNI_FNL = Left(GIORNI_FNL, Len(GIORNI_FNL) - 1)
  492. 'Cells(DG, 10) = GIORNI_FNL
  493. 'Next DG
  494.  
  495. '*****************************
  496.  
  497.  Range("A2:L" & RRW).Select
  498.     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
  499.     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
  500.     With Selection.Borders(xlEdgeLeft)
  501.         .LineStyle = xlContinuous
  502.         .ColorIndex = 0
  503.         .TintAndShade = 0
  504.         .Weight = xlThin
  505.     End With
  506.     With Selection.Borders(xlEdgeTop)
  507.         .LineStyle = xlContinuous
  508.         .ColorIndex = 0
  509.         .TintAndShade = 0
  510.         .Weight = xlThin
  511.     End With
  512.     With Selection.Borders(xlEdgeBottom)
  513.         .LineStyle = xlContinuous
  514.         .ColorIndex = 0
  515.         .TintAndShade = 0
  516.         .Weight = xlThin
  517.     End With
  518.     With Selection.Borders(xlEdgeRight)
  519.         .LineStyle = xlContinuous
  520.         .ColorIndex = 0
  521.         .TintAndShade = 0
  522.         .Weight = xlThin
  523.     End With
  524.     With Selection.Borders(xlInsideVertical)
  525.         .LineStyle = xlContinuous
  526.         .ColorIndex = 0
  527.         .TintAndShade = 0
  528.         .Weight = xlThin
  529.     End With
  530.     With Selection.Borders(xlInsideHorizontal)
  531.         .LineStyle = xlContinuous
  532.         .ColorIndex = 0
  533.         .TintAndShade = 0
  534.         .Weight = xlThin
  535.     End With
  536.     Range("A2:L2").Select
  537.     Selection.Font.Bold = True
  538.     With Selection.Font
  539.         .Name = "Calibri"
  540.         .Size = 13
  541.         .Strikethrough = False
  542.         .Superscript = False
  543.         .Subscript = False
  544.         .OutlineFont = False
  545.         .Shadow = False
  546.         .Underline = xlUnderlineStyleNone
  547.         .ThemeColor = xlThemeColorLight1
  548.         .TintAndShade = 0
  549.         .ThemeFont = xlThemeFontMinor
  550.     End With
  551.     Range("A3:L" & RRW).RowHeight = 34
  552.     Range("A3:L" & RRW).Select
  553.     Selection.VerticalAlignment = xlCenter
  554.  
  555.     Range("B2:G" & RRW).Select
  556.     With Selection 'QUAQUA
  557.        .HorizontalAlignment = xlCenter
  558.         .VerticalAlignment = xlCenter
  559. '        .WrapText = False
  560. '        .Orientation = 0
  561. '        .AddIndent = False
  562. '        .IndentLevel = 0
  563. '        .ShrinkToFit = False
  564. '        .ReadingOrder = xlContext
  565. '        .MergeCells = False
  566.    End With
  567.  
  568.  
  569. '********************************INTESTAZIONE
  570.    Range("C1:I1").Select
  571.     With Selection
  572.         .HorizontalAlignment = xlCenter
  573.         .VerticalAlignment = xlBottom
  574.         .WrapText = False
  575.         .Orientation = 0
  576.         .AddIndent = False
  577.         .IndentLevel = 0
  578.         .ShrinkToFit = False
  579.         .ReadingOrder = xlContext
  580.         .MergeCells = False
  581.     End With
  582.     Selection.Merge
  583.     With Selection
  584.         .HorizontalAlignment = xlCenter
  585.         .VerticalAlignment = xlCenter
  586.         .WrapText = False
  587.         .Orientation = 0
  588.         .AddIndent = False
  589.         .IndentLevel = 0
  590.         .ShrinkToFit = False
  591.         .ReadingOrder = xlContext
  592.         .MergeCells = True
  593.     End With
  594.     ActiveCell.FormulaR1C1 = "PROGRAMMA " & PRG_NUM(1)
  595.     Range("C1:I1").Select
  596.     Selection.Font.Bold = True
  597.     Selection.Font.Size = 22
  598.     Columns("I:I").WrapText = True
  599.     Columns("I:I").AutoFit
  600. '************************************************************
  601.  
  602.  
  603. Workbooks(NAMEFL).Close savechanges:=True
  604.  
  605.  
  606. Next NM
  607. End If
  608. 'Next WW
  609. Next RP
  610. 'COD_WRITE(0, 0) = KJ
  611.  
  612.  
  613. 'Call WRITE_NEWCODE
  614. 'Call UNIFY_FILE
  615.  
  616.  
  617. End Sub
  618.  
  619.  
  620.  
  621. ''Sub upld_fnl_ante()
  622. ''
  623. ''ss = 0
  624. ''
  625. ''NFDATA2 = FreeFile
  626. ''NF_DAT2 = FNLANTE_FOLDER & "FNL_ANTE.txt"
  627. ''
  628. ''If Dir(NF_DAT2) = "" Then Exit Sub
  629. ''
  630. ''Open NF_DAT2 For Input As #NFDATA2
  631. ''
  632. ''Do While Not EOF(NFDATA2)
  633. ''Line Input #NFDATA2, FFF
  634. ''If Not FFF = "" Then
  635. ''ss = ss + 1
  636. ''codfnl(ss, 1) = FFF
  637. ''Line Input #NFDATA2, FFF
  638. ''codfnl(ss, 2) = FFF
  639. ''End If
  640. ''
  641. ''Loop
  642. ''codfnl(0, 0) = ss
  643. ''Close #NFDATA2
  644. ''
  645. ''
  646. ''End Sub
  647.  
  648. Function COD_PIEGA(ByVal CODICE As String, ByVal DISEGNO As String)
  649. COD_PIEGA = ""
  650.  
  651. If InStr(1, ANTE_SPC_VTR, DISEGNO) > 0 Then AN_SVTR = "1" Else AN_SVTR = "0" 'PRESENZA DELLO SPACCO VETRO
  652.  
  653. AN_SPS = Replace(Right(CODICE, 3), "-", "")
  654. CODICE = Left(CODICE, Len(CODICE) - 3)
  655. AN_ALT = Right(CODICE, 4)
  656. CODICE = Left(CODICE, Len(CODICE) - 4)
  657. AN_PL = Right(CODICE, 3)
  658. CODICE = Left(CODICE, Len(CODICE) - 3)
  659. AN_PNCB = Left(CODICE, 2)
  660. CODICE = Right(CODICE, Len(CODICE) - 2)
  661. AN_TIPO = CODICE
  662.  
  663. Select Case AN_SPS
  664. Case 15 'RIVESTITE
  665.    Select Case AN_TIPO
  666.     Case "TL", "TR"
  667.         COD_PIEGA = "11"
  668.     Case "S"
  669.         If AN_PL = "600" Or AN_PL = "650" Then
  670.             COD_PIEGA = "9"
  671.         Else
  672.             If AN_SVTR = "0" Then
  673.                 COD_PIEGA = "5"
  674.             Else
  675.                 COD_PIEGA = "15"
  676.             End If
  677.         End If
  678.     Case "AD", "AS"
  679.         If AN_PL = "600" Then
  680.             COD_PIEGA = "7"
  681.         Else
  682.             If AN_SVTR = "0" Then
  683.                 COD_PIEGA = "5"
  684.             Else
  685.                 COD_PIEGA = "15"
  686.             End If
  687.         End If
  688.     Case "CC"
  689.         COD_PIEGA = "13"
  690.     End Select
  691.  
  692. Case 18 'ANTIRUGGINE
  693.    Select Case AN_TIPO
  694.     Case "TL", "TR"
  695.         COD_PIEGA = "12"
  696.     Case "S"
  697.         If AN_PL = "600" Or AN_PL = "650" Then
  698.             COD_PIEGA = "10"
  699.         Else
  700.             COD_PIEGA = "6"
  701.         End If
  702.     Case "AD", "AS"
  703.         If AN_PL = "600" Then
  704.             COD_PIEGA = "8"
  705.         Else
  706.             COD_PIEGA = "6"
  707.         End If
  708.     Case "CC"
  709.         COD_PIEGA = "14"
  710.     End Select
  711.  
  712. Case Else
  713. MsgBox ("ERRORE CODICE PIEGA")
  714. End Select
  715.  
  716.  
  717.  
  718. End Function
  719.  
  720.  
  721. Sub WRITE_NEWCODE()
  722.  
  723.  
  724.  
  725. NFDATA3 = FreeFile
  726. NF_DAT3 = FNLANTE_FOLDER & "FNL_ANTE1.txt"
  727. Open NF_DAT3 For Output As #NFDATA3
  728.  
  729. For AA = 1 To Val(COD_WRITE(0, 0))
  730. Print #NFDATA3, COD_WRITE(AA, 1)
  731. Print #NFDATA3, COD_WRITE(AA, 2)
  732. Next AA
  733.  
  734. Close #NFDATA3
  735.  
  736.  
  737. End Sub
  738.  
  739. Sub UNIFY_FILE()
  740.  
  741.  
  742. NFDATA33 = FreeFile
  743. NF_DAT33 = FNLANTE_FOLDER & "FNL_ANTE3.txt"
  744. Open NF_DAT33 For Output As #NFDATA33
  745.  
  746.  
  747. NFDATA44 = FreeFile
  748. NF_DAT44 = FNLANTE_FOLDER & "FNL_ANTE.txt"
  749. If Dir(NF_DAT44) <> "" Then
  750. Open NF_DAT44 For Input As #NFDATA44
  751.  
  752. Do While Not EOF(NFDATA44)
  753. Line Input #NFDATA44, VVV
  754.  
  755. Print #NFDATA33, VVV
  756. Loop
  757. Close #NFDATA44
  758. Kill (NF_DAT44)
  759. End If
  760.  
  761.  
  762. NFDATA44 = FreeFile
  763. NF_DAT44 = FNLANTE_FOLDER & "FNL_ANTE1.txt"
  764. If Dir(NF_DAT44) <> "" Then
  765. Open NF_DAT44 For Input As #NFDATA44
  766.  
  767. Do While Not EOF(NFDATA44)
  768. Line Input #NFDATA44, VVV
  769.  
  770. Print #NFDATA33, VVV
  771. Loop
  772. Close #NFDATA44
  773. Kill (NF_DAT44)
  774. End If
  775.  
  776. Close #NFDATA33
  777.  
  778. Name NF_DAT33 As FNLANTE_FOLDER & "FNL_ANTE.txt"
  779.  
  780.  
  781. End Sub
  782.  
  783.  
  784.  
  785.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!