View difference between Paste ID: Hgd6WYGE and Y1mzxD8m

-'Solid DXF
+Prd Esterna
 
-Dim swApp As SldWorks.SldWorks
+Dim STR_RIGA(1000, 11) As String
-Dim Model As ModelDoc2
+'Dim codfnl(2000, 2) As String
-Dim DTable As DesignTable
+Dim COD_WRITE(2000, 2) As String
-Dim WS_OBJ As Excel.Worksheet
+
-Dim part As Object
+Sub EXTERNAL_PROD()
-Dim SelMgr As Object
+
-Dim NR_View As Byte
+
 
 'STR_DXF = "+"
-Sub MODEL_SUB(ByVal NFD As String, ByVal ACTACT As Byte)
+'
-ACT_MOD = INFO_DAT(NFD, 0, 6)
+''****************************FAI I DXF CHE NON ESISTONO
 'For NFGG = 1 To NM_DT
-Set swApp = CreateObject("SldWorks.Application")
+'
-swApp.Visible = False
+'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
 'If INFO_DAT(NFGG, 0, 23) > 0 And INFO_DAT(NFGG, 0, 29) = 0 And INFO_DAT(NFGG, 0, 11) = "1.5" Then
-Set part = swApp.OpenDoc6(SLD_PTH & Left(INFO_DAT(NFD, 0, 6), 10) & INFO_DAT(NFD, 0, 9) & ".SLDPRT", 1, 0, "", 0, 0) 'AGGIUNTA REVISIONE
+'
-Select Case swApp.ActiveDoc.Extension.HasDesignTable()
+'FAI_DXF:
-Case True
+'If InStr(1, STR_DXF, INFO_DAT(NFGG, 0, 16)) = 0 Then
-Case False
+'Call MODEL_SUB(NFGG, 2)
-MsgBox "THIS FILE DO NOT CONTAINS ANY TABLE DESIGN", vbCritical
+'Call READ_DXF(OUTPUT_FOLDER & Right(INFO_DAT(NFGG, 0, 3), 13) & ".DXF", NFGG)
-Exit Sub
+'STR_DXF = STR_DXF & "+" & INFO_DAT(NFGG, 0, 16) & "+"
 '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
-Set Model = swApp.ActiveDoc
+'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
-filePth = Model.GetPathName
+'
 'End If
-STR_FNAME = Right(filePth, InStr(1, StrReverse(filePth), "\", vbBinaryCompare) - 1)
+'End If
 'Next NFGG
-Set DTable = Model.GetDesignTable
+''*****************************************************
-GET_ERR = swApp.GetErrorMessages(vMsgs, vMsgIds, vMsgTypes) 'RESETTA LO STACK MESSAGGI
+
 
-isGood = DTable.Attach
+Call WRITE_REPORT 'SCRIVO IL REPORT PER LA PRODUZINE ESTERNA
-If isGood = False Then
+
-MsgBox "Table attachment failed", vbCritical
+
-Exit Sub
+
 
 
-Set WS_OBJ = DTable.Worksheet
+Sub WRITE_REPORT() 'CREAZIONE REPORT PER PRODUZIONE ESTERNA
-Call TAB_EDT(NFD)
+
-Call MOD_CHECK(NFD)
+
 ''Call upld_fnl_ante 'CARICA I CODICI
-VVVV = Replace(INFO_DAT(NFD, 0, 7), "H", "")
+
-VVVV = Replace(VVVV, "G", "")
+
-VVVV = Replace(VVVV, "P", "")
+KJ = 0
-VVVV = Val(VVVV)
+
 For RP = 1 To 2
- VW = VW_SET(VVVV)
+
- RW = DTable.Worksheet.Range("VW_ROT", "VW_ROT").Value
+'For WW = 1 To 2
- MD = INFO_DAT(NFD, 0, 9)
+
 'Select Case WW
-For i = 1 To 100
+'Case 1
-If InStr(1, INFO_DAT(NFD, 1, i), "MOD", vbTextCompare) > 0 Then
+'PRG_AVL = "_1_2_3_"
-REV_ON_DAT = INFO_DAT(NFD, 2, i)
+'Case 2
 'PRG_AVL = "_4_5_"
 'End Select
-Next i
+
 PRIMO_PRG = ""
-If MD <> REV_ON_DAT Then MsgBox "ATTENZIONE: INDICE DI REVISIONE ERRATO SU MODELLO " & INFO_VAR(0, 0), vbCritical
+PRG_TOT2 = ""
-    DTable.UpdateModel
+For PT = 1 To 5
-    DTable.Detach
+If PRG_NUM(PT) = "" Then Exit For
-GET_ERROR = swApp.GetErrorMessages(vMsgs, vMsgIds, vMsgTypes)
+'If InStr(PRG_AVL, Right(PRG_NUM(PT), 1)) > 0 Then
-If GET_ERROR > 0 Then INFO_DAT(NFD, 0, 20) = ERR_TRAPP(GET_ERROR, vMsgs, vMsgIds, vMsgTypes) Else INFO_DAT(NFD, 0, 20) = ""
+If PRIMO_PRG = "" Then
 PRIMO_PRG = PRG_NUM(PT)
-Call SUB_DXF(NFD, VW, RW, ACTACT)
+PRG_TOT2 = PRIMO_PRG
 Else
-Erase INFO_VAR
+PRG_TOT2 = PRIMO_PRG & PRG_NUM(PT)
-NR_View = Empty
+
-
+'End If
-Set part = swApp.ActiveDoc
+Next PT
-Set SelMgr = part.SelectionManager
+PRG_TOT2 = Replace(PRG_TOT2, "-", "")
-Set part = Nothing
+
-swApp.CloseDoc STR_FNAME
+
-'swApp.ExitApp
+
 If PRG_TOT2 <> "" Then
 For NM = 1 To NN_MAT 'MATERIALE
-RRR:
+Erase STR_RIGA
-
+
 If RP = 2 Then SUFF = "_4AN" Else SUFF = "_2AN"
 NAMEFL = "FNL-" & PRG_TOT2 & "-" & Replace(STR_MTR(NM), " ", "") & "-OS" & SUFF & ".xlsx"
 NAMEFLPTH = OUTPUT_FOLDER & NAMEFL
-Sub TAB_EDT(ByVal NFG As Integer)
+'FINO QUA PER DARE IL TITOLO
-Set DTable = part.GetDesignTable
+
-If DTable.Attach = False Then
+
-MsgBox "Table attachment failed", vbCritical
+If Len(Dir(NAMEFLPTH)) > 0 Then Kill NAMEFLPTH
-Exit Sub
+Dim wb As Workbook
 Set wb = Workbooks.Add()
 wb.SaveAs fileName:=NAMEFLPTH
-On Error GoTo ERR_LBL
+Workbooks.Open fileName:=NAMEFLPTH
-VARCOUNT = 0
+
-TAB_NAM = ActiveWorkbook.Name
+Cells(1 + 1, 1) = "MATERIALE"
-For Each NAMS In Workbooks(TAB_NAM).Names
+Cells(1 + 1, 2) = "QTOT"
-If InStr(1, NAMS.Name, "VAR_", vbBinaryCompare) Then
+Cells(1 + 1, 3) = "COD"
-DTable.Worksheet.Range(NAMS.Name, NAMS.Name).Value = 0
+Cells(1 + 1, 4) = "Controllo"
-VARCOUNT = VARCOUNT + 1
+Cells(1 + 1, 5) = "ALS"
 Cells(1 + 1, 6) = "AVS"
-Next NAMS
+Cells(1 + 1, 7) = "AVD"
 Cells(1 + 1, 8) = "ALD"
-For i = 1 To 100
+Cells(1 + 1, 9) = "COMMESSA"
-LAB = Replace(INFO_DAT(NFG, 1, i), ".", "")
+Cells(1 + 1, 10) = "COD PROG"
-VLR = INFO_DAT(NFG, 2, i)
+Cells(1 + 1, 11) = "Omega"
 Cells(1 + 1, 12) = "SEQ"
-If InStr(1, LAB, "VER", vbBinaryCompare) > 0 Then
+
-VLR = Replace(VLR, "H", "")
+'Cells(1, 11) = "TURNO"
-VLR = Replace(VLR, "G", "")
+Columns("I:I").NumberFormat = "@"
-VLR = Replace(VLR, "P", "")
+Columns("J:J").NumberFormat = "@"
-VLR = Val(VLR)
+
 Columns("A:A").ColumnWidth = 12
 Columns("B:B").ColumnWidth = 6.5
-For Each NAMS In Workbooks(TAB_NAM).Names
+Columns("C:C").ColumnWidth = 18
-If InStr(1, NAMS.Name, ".", vbBinaryCompare) > 0 Then MsgBox "ERRORE ETICHETTA SU TABELLA " & swApp.ActiveDoc
+Columns("D:D").ColumnWidth = 10
-If NAMS.Name = "VAR_" & LAB Then
+Columns("E:E").ColumnWidth = 8
-DTable.Worksheet.Range("VAR_" & LAB, "VAR_" & LAB).Value = VLR
+Columns("F:F").ColumnWidth = 8
-VARWRITE = VARWRITE + 1
+Columns("G:G").ColumnWidth = 8
 Columns("H:H").ColumnWidth = 8
-Next NAMS
+Columns("I:I").ColumnWidth = 30
-Next i
+Columns("J:J").ColumnWidth = 12
 Columns("K:K").ColumnWidth = 8
-DTable.UpdateModel
+
-DTable.Detach
+    Columns("H:H").Select
-GoTo ENDSUB
+    With Selection
-ERR_LBL:
+        .HorizontalAlignment = xlCenter
-MsgBox "ERRORE SU TABELLA " & INFO_DAT(NFG, 0, 6)
+        .VerticalAlignment = xlBottom
-ENDSUB:
+        .WrapText = False
         .Orientation = 0
         .AddIndent = False
-Sub SUB_DXF(ByVal NFG As Integer, ByVal V_VIEW As Byte, ByVal R_VIEW As Double, ByVal ACTACT As Byte)
+        .IndentLevel = 0
         .ShrinkToFit = False
-Dim boolstatus As Boolean
+        .ReadingOrder = xlContext
-Dim longstatus As Long, longwarnings As Long
+        .MergeCells = False
-Dim Feature As Object
+    End With
-Dim filePth As String
+
-Dim DrawWiew As Object
+
-Dim sVWiew  As SldWorks.View
+Cells(2, 1).Select
 ActiveCell.Select
-Set swModel = swApp.ActiveDoc
+    With Selection
-Set part = swApp.ActiveDoc
+        .HorizontalAlignment = xlLeft
-Set SelMgr = part.SelectionManager
+        .VerticalAlignment = xlBottom
         .WrapText = False
-filePth = swModel.GetPathName
+        .Orientation = 0
-drvVal = Left(filePth, 1)
+        .AddIndent = False
-lenext = InStr(1, StrReverse(filePth), "\", vbBinaryCompare) - 1
+        .ShrinkToFit = False
-fileName = Left(Right(filePth, lenext), Len(Right(filePth, lenext)) - InStr(1, StrReverse(Right(filePth, lenext)), ".", vbBinaryCompare))
+        .MergeCells = False
     End With
-part.SetBendState 2
+
-boolstatus = part.EditRebuild3
+    With ActiveSheet.PageSetup
         .PrintTitleRows = ""
-'Set part = swApp.OpenDoc6("\\NT1\TEP-VAULT\SWP\WitturETODrawing.DRWDOT", 3, 0, "", longstatus, longwarnings)
+        .PrintTitleColumns = ""
-Set part = swApp.OpenDoc6("\\nt1\UFFTEP\3D_parametrizzati\SWP\WitturETODrawing.DRWDOT", 3, 0, "", longstatus, longwarnings)
+    End With
-Set DrawWiew = part.CreateDrawViewFromModelView2(filePth, VDS(V_VIEW), 0, 0, 0)
+    ActiveSheet.PageSetup.PrintArea = ""
     With ActiveSheet.PageSetup
-boolstatus = part.Extension.SelectByID2(NAME_VW, "DRAWINGVIEW", 0, 0, 0, False, 0, Nothing, 0)
+        .LeftHeader = "PROGRAMMA FNL-" & STR_MTR(NM) & "-OS" & SUFF & " FORNITURA ESTERNA"
-boolstatus = part.DrawingViewRotate(R_VIEW / 57.29578)   'TO ROTATE VIEW
+        .CenterHeader = ""
         .RightHeader = "Doc 1.SK.U.STM501"
-    Set swModel = swApp.ActiveDoc
+        .LeftFooter = "&F"
-    Set swSelMgr = swModel.SelectionManager
+        .CenterFooter = ""
-    Set swModelDocExt = swModel.Extension
+        .RightFooter = "Pag. " & "&P" & " \ " & "&N"
         .LeftMargin = Application.InchesToPoints(0.33)
- Call DRW_CLR(1)
+        .RightMargin = Application.InchesToPoints(0.33)
         .TopMargin = Application.InchesToPoints(0.38)
         .BottomMargin = Application.InchesToPoints(0.44)
-If ACTACT = 1 Then
+        .HeaderMargin = Application.InchesToPoints(0.17)
-If Application.UserName = "Galloni A." Or Application.UserName = "Sassi, Samuele (Wittur Italy)" Or Application.UserName = "Armencea, Decebal (Wittur Italy)" Then
+        .FooterMargin = Application.InchesToPoints(0.2)
-part.SaveAs2 OUTPUT_FOLDER & INFO_DAT(NFG, 0, 16) & ".DXF", 0, True, False 'NOME CON CUI SI SALVA IL DXF
+        .PrintHeadings = False
         .PrintGridlines = False
-part.SaveAs2 DXF_CFOLD & INFO_DAT(NFG, 0, 16) & ".DXF", 0, True, False 'NOME CON CUI SI SALVA IL DXF
+        .PrintComments = xlPrintNoComments
         .CenterHorizontally = False
         .CenterVertically = False
-If ACTACT = 2 Then part.SaveAs2 OUTPUT_FOLDER & INFO_DAT(NFG, 0, 16) & ".DXF", 0, True, False
+        .Orientation = xlLandscape
-
+        .Draft = False
         .PaperSize = xlPaperA4
-Set part = swApp.ActiveDoc
+        .FirstPageNumber = xlAutomatic
-Set SelMgr = part.SelectionManager
+        .Order = xlDownThenOver
-Set part = Nothing
+        .BlackAndWhite = False
-swApp.CloseDoc swApp.ActiveDoc.GetTitle
+        .Zoom = 80
-Set part = swApp.ActivateDoc2(filePth, False, longstatus)
+    End With
 
-part.SetBendState 3
+
-boolstatus = part.EditRebuild3
+
 
 For NN = 1 To NN_CODE 'COMMESSE ANTE
 For I3 = 1 To 1000 'NUMERO DATI GESTITI
 
 'If InStr(1, PRG_AVL, Right(INFO_DAT(I3, 0, 0), 1)) > 0 Then 'NUMERO PROGRAMMA
-Function VDS(ByVal NVIEW As Byte) As String
+If INFO_DAT(I3, 0, 25) = STR_MTR(NM) Then
 If INFO_DAT(I3, 0, 2) = STR_COD(NN) And INFO_DAT(I3, 0, 23) > 0 Then
-LNG = UCase(swApp.GetCurrentLanguage)
+
 STR_RIGA(NN, 3) = INFO_DAT(I3, 0, 24) 'CODICE ANTE
-Select Case LNG
+STR_RIGA(NN, 1) = INFO_DAT(I3, 0, 25) 'CODICE MATERIALE
-Case "ENGLISH"
+
- CLang = 1
+
-Case "ITALIANO", "ITALIAN"
+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
- CLang = 2
+STR_RIGA(NN, 2) = Val(INFO_DAT(I3, 0, 4)) 'QUANTITà
 STR_RIGA(NN, 8) = INFO_DAT(I3, 0, 2) 'COMMESSA
-MsgBox "Errore su linguaggio", vbCritical
+STR_RIGA(NN, 9) = INFO_DAT(I3, 0, 32) 'PRG
 STR_RIGA(NN, 10) = INFO_DAT(I3, 0, 36) 'SHIFT
 STR_RIGA(NN, 11) = INFO_DAT(I3, 0, 6) 'CODICE DISEGNO
-Select Case NVIEW
+''If InStr(1, STR_RIGA(NN, 8), INFO_DAT(I3, 0, 2)) = 0 Then
-Case 1
+''STR_RIGA(NN, 8) = STR_RIGA(NN, 8) & " " & INFO_DAT(I3, 0, 2) & "-" & INFO_DAT(I3, 0, 4) 'COMMESSE + QUANTITà
-  If CLang = 1 Then VDS = "*Top"
+''STR_RIGA(NN, 2) = Val(STR_RIGA(NN, 2)) + Val(INFO_DAT(I3, 0, 4)) 'QUANTITà
-  If CLang = 2 Then VDS = "*Superiore"
+''End If
-Case 2
+
-  If CLang = 1 Then VDS = "*Bottom"
+
-  If CLang = 2 Then VDS = "*Inferiore"
+'End If
-Case 3
+
-  If CLang = 1 Then VDS = "*Right"
+
-  If CLang = 2 Then VDS = "*Destra"
+Next I3
-Case 4
+Next NN
-  If CLang = 1 Then VDS = "*Left"
+''''*******************************************************************************
-  If CLang = 2 Then VDS = "*Sinistra"
+
-Case 5
+''For RR2 = 1 To NN_CODE 'SOMMA COMMESSE UGUALI
-  If CLang = 1 Then VDS = "*Front"
+''For RR3 = 1 + RR2 To NN_CODE
-  If CLang = 2 Then VDS = "*Frontale"
+''
 ''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
 ''
 ''STR_RIGA(RR2, 2) = Val(STR_RIGA(RR2, 2)) + Val(STR_RIGA(RR3, 2))
 ''STR_RIGA(RR2, 8) = STR_RIGA(RR2, 8) & "  " & STR_RIGA(RR3, 8)
 ''
 ''STR_RIGA(RR3, 1) = ""
-Function NAME_VW() As String
+''STR_RIGA(RR3, 2) = ""
 ''STR_RIGA(RR3, 3) = ""
-    Dim swModel                 As SldWorks.ModelDoc2
+''STR_RIGA(RR3, 4) = ""
-    Dim swDraw                  As SldWorks.DrawingDoc
+''STR_RIGA(RR3, 5) = ""
-    Dim swSheet                 As SldWorks.Sheet
+''STR_RIGA(RR3, 6) = ""
-    Dim sVWiew                  As SldWorks.View
+''STR_RIGA(RR3, 7) = ""
 ''STR_RIGA(RR3, 8) = ""
-    Set swModel = swApp.ActiveDoc
+''Else
-    Set swDraw = swModel
+''Exit For
-    Set sVWiew = swDraw.GetFirstView
+''End If
-    Set sVWiew = sVWiew.GetNextView
+''Next RR3
 ''Next RR2
-    NAME_VW = sVWiew.GetName2
+
 ''''*******************************************************************************
-If NAME_VW <> "" Then Else MsgBox "NESSUNA VISTA CARICATA", vbCritical
+
-
+RR = 1 ' 0
 ''For SH = 2 To 1 Step -1
 'For SQ = 300 To 1 Step -1
 For SQ = 1 To 300
 For NN1 = 1 To UBound(STR_RIGA)
-Function VW_SET(ByVal NV As String) As Byte
+
 ''If Val(STR_RIGA(NN1, 10)) = SH Then
-NV = Replace(NV, "G", "")
+If Val(STR_RIGA(NN1, 9)) = SQ Then
-NV = Replace(NV, "H", "")
+If STR_RIGA(NN1, 3) <> "" Then
 
-On Error Resume Next
+RR = RR + 1
-VW_SET = 99
+Cells(RR + 1, 1) = STR_RIGA(NN1, 1)
-NVR = Val(Trim(NV))
+Cells(RR + 1, 2) = STR_RIGA(NN1, 2)
 Cells(RR + 1, 3) = STR_RIGA(NN1, 3)
-VW_SET = DTable.Worksheet.Range("VW_00", "VW_00").Value
+Cells(RR + 1, 4 + 1) = STR_RIGA(NN1, 4)
-If VW_SET = 99 Then
+Cells(RR + 1, 5 + 1) = STR_RIGA(NN1, 5)
 Cells(RR + 1, 6 + 1) = STR_RIGA(NN1, 6)
 Cells(RR + 1, 7 + 1) = STR_RIGA(NN1, 7)
-Select Case NVR
+Cells(RR + 1, 8 + 1) = STR_RIGA(NN1, 8)
-Case 1, 3
+If InStr(1, comm_omg_spc, STR_RIGA(NN1, 8)) > 0 Then
-VW_SET = DTable.Worksheet.Range("VW_01", "VW_01").Value
+Cells(RR + 1, 10 + 1) = "SI"
-Case 2, 4
+
-VW_SET = DTable.Worksheet.Range("VW_02", "VW_02").Value
+Cells(RR + 1, 12) = STR_RIGA(NN1, 9)
 Cells(RR + 1, 9 + 1) = COD_PIEGA(STR_RIGA(NN1, 3), STR_RIGA(NN1, 11))
 
 
 'Cells(RR + 1, 11) = STR_RIGA(NN1, 10)
 
 '''''**************************************************************GENERO IL NUOVO CODICE DI IDENTIFICAZIONE
 ''''VVV = Cells(RR + 1, 4 + 1) & Cells(RR + 1, 5 + 1) & Cells(RR + 1, 6 + 1) & Cells(RR + 1, 7 + 1)
 ''''
 ''''
 ''''If Cells(RR + 1, 4 + 1) = "" Then
-Sub DRW_CLR(ByVal ZSD As Byte)
+''''CC1 = "N"
 ''''Else
-Set swDraw = swApp.ActiveDoc
+''''CC1 = Right(Cells(RR + 1, 4 + 1), 2)
-Set swSheet = swDraw.GetCurrentSheet
+''''End If
-Set swView = swDraw.GetFirstView
+''''If Cells(RR + 1, 5 + 1) = "" Then
-Set swView = swView.GetNextView
+''''CC2 = "N"
-Set swAnn = swView.GetFirstAnnotation
+''''Else
-Do While Not Nothing Is swAnn
+''''CC2 = Right(Cells(RR + 1, 5 + 1), 2)
-swAnn.Visible = 3
+''''End If
-Set swAnn = swAnn.GetNext3
+''''If Cells(RR + 1, 6 + 1) = "" Then
 ''''CC3 = "N"
 ''''Else
-Set part = swApp.ActiveDoc
+''''CC3 = Right(Cells(RR + 1, 6 + 1), 2)
-Set SelMgr = part.SelectionManager
+''''End If
-boolstatus = part.SetUserPreferenceToggle(196, False)
+''''If Cells(RR + 1, 7 + 1) = "" Then
 ''''CC4 = "N"
 ''''Else
 ''''CC4 = Right(Cells(RR + 1, 7 + 1), 2)
 ''''End If
-Sub MOD_CHECK(ByVal NFG As Integer)
+''''CCC = CC1 & CC2 & CC3 & CC4
 ''''
-On Error GoTo ERR
+''''
-INFO_VAR(0, 1) = DTable.Worksheet.Range("REV_IND", "REV_IND").Value
+''''NUM_CC = quanteVolte(CCC, "N")
-GoTo ENDFUNCT
+''''Select Case NUM_CC
-ERR:
+''''Case Is >= 2
-MsgBox "ATTENZIONE: NON RILEVATO INDICE DI REVISIONE SU MODELLO " & INFO_DAT(NFG, 0, 0)
+''''If Cells(RR + 1, 4 + 1) = "" Then
-ENDFUNCT:
+''''CC1 = "N"
 ''''Else
 ''''CC1 = Right(Cells(RR + 1, 4 + 1), 3)
 ''''End If
 ''''If Cells(RR + 1, 5 + 1) = "" Then
-Function ERR_TRAPP(Count, vMsgs As Variant, vMsgIds As Variant, vMsgTypes As Variant) As String
+''''CC2 = "N"
-ERR_STR = ""
+''''Else
-For i = 0 To (Count - 1)
+''''CC2 = Right(Cells(RR + 1, 5 + 1), 3)
-ERR_STR = ERR_STR & " " & vMsgs(i)
+''''End If
-Next i
+''''If Cells(RR + 1, 6 + 1) = "" Then
-ERR_STR = Replace(ERR_STR, Chr(13), "")
+''''CC3 = "N"
-ERR_TRAPP = Trim(Replace(ERR_STR, "Avvertenza: ", ""))
+''''Else
 ''''CC3 = Right(Cells(RR + 1, 6 + 1), 3)
 ''''End If
 ''''If Cells(RR + 1, 7 + 1) = "" Then
 ''''CC4 = "N"
 ''''Else
 ''''CC4 = Right(Cells(RR + 1, 7 + 1), 3)
 ''''End If
 ''''CCC = CC1 & CC2 & CC3 & CC4
 ''''Case Is < 2
 ''''
 ''''CCC = CCC
 ''''End Select
 ''''
 '''''************************************CODICI DOPPI
 ''''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"
 ''''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"
 ''''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"
 ''''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"
 ''''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"
 ''''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"
 ''''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"
 ''''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"
 '''''************************************************
 ''''Cells(RR + 1, 9 + 1) = CCC
 ''''
 ''''
 ''''
 ''''ATT = 0
 ''''For G1 = 1 To Val(codfnl(0, 0))
 ''''If CCC = codfnl(G1, 1) Then
 ''''If VVV = codfnl(G1, 2) Then
 ''''ATT = 1
 ''''Else
 ''''MsgBox ("ATTENZIONE CODICE PROGRAMMA " & CCC & " DOPPIO, NOMINARLO DIVERSAMENTE")
 ''''End If
 ''''End If
 ''''Next G1
 ''''
 ''''If ATT = 0 Then
 ''''KJ = KJ + 1
 ''''COD_WRITE(KJ, 1) = CCC
 ''''COD_WRITE(KJ, 2) = VVV
 ''''End If
 
 '**********************************************************************************************
 End If
 End If
 'End If
 Next NN1
 Next SQ
 ''Next SH
 
 
 
 For RR2 = 2 To NN_CODE 'SOMMA COMMESSE UGUALI
 For RR3 = 1 + RR2 To NN_CODE
 
 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
 
 Cells(RR2, 2) = Val(Cells(RR2, 2)) + Val(Cells(RR3, 2))
 Cells(RR2, 8 + 1) = Cells(RR2, 8 + 1) & "  " & Cells(RR3, 8 + 1)
 
 Cells(RR3, 1) = ""
 Cells(RR3, 2) = ""
 Cells(RR3, 3) = ""
 Cells(RR3, 4) = ""
 Cells(RR3, 5) = ""
 Cells(RR3, 6) = ""
 Cells(RR3, 7) = ""
 Cells(RR3, 8) = ""
 Cells(RR3, 9) = ""
 Cells(RR3, 10) = ""
 Cells(RR3, 11) = ""
 Cells(RR3, 12) = ""
 
 Else
 Exit For
 End If
 Next RR3
 Next RR2
 
 
 
 
 
 'CANCELLA LE RIGHE VUOTE
 CANC_RIGA:
 For N1 = 1 To NN
 If Cells(N1 + 1, 3) = "" Then
 Rows(N1 + 1).Delete
 NN = NN - 1
 GoTo CANC_RIGA
 End If
 Next N1
 '************************
 
 
 '*******************************METTE LE DUE ANTE PER ULTIME
 Dim cll(200, 12) As String
 
 N4 = 0
 Erase cll
 CANC_RIGA2:
 For N1 = 1 To 100
 If Cells(N1 + 1, 1) <> "" Then
 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
 N4 = N4 + 1
 cll(N4, 1) = Cells(N1 + 1, 1)
 cll(N4, 2) = Cells(N1 + 1, 2)
 cll(N4, 3) = Cells(N1 + 1, 3)
 cll(N4, 4) = Cells(N1 + 1, 4)
 cll(N4, 5) = Cells(N1 + 1, 5)
 cll(N4, 6) = Cells(N1 + 1, 6)
 cll(N4, 7) = Cells(N1 + 1, 7)
 cll(N4, 8) = Cells(N1 + 1, 8)
 cll(N4, 9) = Cells(N1 + 1, 9)
 cll(N4, 10) = Cells(N1 + 1, 10)
 cll(N4, 11) = Cells(N1 + 1, 11)
 cll(N4, 12) = Cells(N1 + 1, 12)
 
 Rows(N1 + 1).Delete
 GoTo CANC_RIGA2
 End If
 End If
 Next N1
 
 
 
 n5 = 0
 For N2 = 1 To 150
 
 If Cells(N2 + 1, 1) = "" Then
 n5 = n5 + 1
 If cll(n5, 1) = "" Then Exit For
 Cells(N2 + 1, 1) = cll(n5, 1)
 Cells(N2 + 1, 2) = cll(n5, 2)
 Cells(N2 + 1, 3) = cll(n5, 3)
 Cells(N2 + 1, 4) = cll(n5, 4)
 Cells(N2 + 1, 5) = cll(n5, 5)
 Cells(N2 + 1, 6) = cll(n5, 6)
 Cells(N2 + 1, 7) = cll(n5, 7)
 Cells(N2 + 1, 8) = cll(n5, 8)
 Cells(N2 + 1, 9) = cll(n5, 9)
 Cells(N2 + 1, 10) = cll(n5, 10)
 Cells(N2 + 1, 11) = cll(n5, 11)
 Cells(N2 + 1, 12) = cll(n5, 12)
 End If
 
 Next N2
 '**********************************************
 
 If RP = 2 Then
 CANC_RIGA22:
 For N1 = 2 To 200
 If Cells(N1 + 1, 1) <> "" Then
 If Cells(N1 + 1, 5) = "" Or Cells(N1 + 1, 6) = "" Or Cells(N1 + 1, 7) = "" Or Cells(N1 + 1, 8) = "" Then
 Rows(N1 + 1).Delete
 GoTo CANC_RIGA22
 End If
 End If
 Next N1
 End If
 
 
 If RP = 1 Then 'PER CANCELLARE LE RIGHE RELATIVE ALLE 4 ANTE
 CANC_RIGA3:
 For N1 = 2 To 200
 If Cells(N1 + 1, 1) <> "" Then
 If Cells(N1 + 1, 5) <> "" And Cells(N1 + 1, 6) <> "" And Cells(N1 + 1, 7) <> "" And Cells(N1 + 1, 8) <> "" Then
 Rows(N1 + 1).Delete
 GoTo CANC_RIGA3
 End If
 End If
 Next N1
 End If
 
 
 
 RRW = NN + 1
 
 
 '************AGGIUNGO I GIORNI
 'For DG = 2 To RRW
 'GIORNI_FNL = PRG_NUM(1) 'Replace(PRG_AVL, "_", "-")
 ''GIORNI_FNL = Right(GIORNI_FNL, Len(GIORNI_FNL) - 1)
 ''GIORNI_FNL = Left(GIORNI_FNL, Len(GIORNI_FNL) - 1)
 'Cells(DG, 10) = GIORNI_FNL
 'Next DG
 
 '*****************************
 
  Range("A2:L" & RRW).Select
     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
     With Selection.Borders(xlEdgeLeft)
         .LineStyle = xlContinuous
         .ColorIndex = 0
         .TintAndShade = 0
         .Weight = xlThin
     End With
     With Selection.Borders(xlEdgeTop)
         .LineStyle = xlContinuous
         .ColorIndex = 0
         .TintAndShade = 0
         .Weight = xlThin
     End With
     With Selection.Borders(xlEdgeBottom)
         .LineStyle = xlContinuous
         .ColorIndex = 0
         .TintAndShade = 0
         .Weight = xlThin
     End With
     With Selection.Borders(xlEdgeRight)
         .LineStyle = xlContinuous
         .ColorIndex = 0
         .TintAndShade = 0
         .Weight = xlThin
     End With
     With Selection.Borders(xlInsideVertical)
         .LineStyle = xlContinuous
         .ColorIndex = 0
         .TintAndShade = 0
         .Weight = xlThin
     End With
     With Selection.Borders(xlInsideHorizontal)
         .LineStyle = xlContinuous
         .ColorIndex = 0
         .TintAndShade = 0
         .Weight = xlThin
     End With
     Range("A2:L2").Select
     Selection.Font.Bold = True
     With Selection.Font
         .Name = "Calibri"
         .Size = 13
         .Strikethrough = False
         .Superscript = False
         .Subscript = False
         .OutlineFont = False
         .Shadow = False
         .Underline = xlUnderlineStyleNone
         .ThemeColor = xlThemeColorLight1
         .TintAndShade = 0
         .ThemeFont = xlThemeFontMinor
     End With
     Range("A3:L" & RRW).RowHeight = 34
     Range("A3:L" & RRW).Select
     Selection.VerticalAlignment = xlCenter
 
     Range("B2:G" & RRW).Select
     With Selection 'QUAQUA
         .HorizontalAlignment = xlCenter
         .VerticalAlignment = xlCenter
 '        .WrapText = False
 '        .Orientation = 0
 '        .AddIndent = False
 '        .IndentLevel = 0
 '        .ShrinkToFit = False
 '        .ReadingOrder = xlContext
 '        .MergeCells = False
     End With
 
 
 '********************************INTESTAZIONE
     Range("C1:I1").Select
     With Selection
         .HorizontalAlignment = xlCenter
         .VerticalAlignment = xlBottom
         .WrapText = False
         .Orientation = 0
         .AddIndent = False
         .IndentLevel = 0
         .ShrinkToFit = False
         .ReadingOrder = xlContext
         .MergeCells = False
     End With
     Selection.Merge
     With Selection
         .HorizontalAlignment = xlCenter
         .VerticalAlignment = xlCenter
         .WrapText = False
         .Orientation = 0
         .AddIndent = False
         .IndentLevel = 0
         .ShrinkToFit = False
         .ReadingOrder = xlContext
         .MergeCells = True
     End With
     ActiveCell.FormulaR1C1 = "PROGRAMMA " & PRG_NUM(1)
     Range("C1:I1").Select
     Selection.Font.Bold = True
     Selection.Font.Size = 22
     Columns("I:I").WrapText = True
     Columns("I:I").AutoFit
 '************************************************************
 
 
 Workbooks(NAMEFL).Close savechanges:=True
 
 
 Next NM
 End If
 'Next WW
 Next RP
 'COD_WRITE(0, 0) = KJ
 
 
 'Call WRITE_NEWCODE
 'Call UNIFY_FILE
 
 
 End Sub
 
 
 
 ''Sub upld_fnl_ante()
 ''
 ''ss = 0
 ''
 ''NFDATA2 = FreeFile
 ''NF_DAT2 = FNLANTE_FOLDER & "FNL_ANTE.txt"
 ''
 ''If Dir(NF_DAT2) = "" Then Exit Sub
 ''
 ''Open NF_DAT2 For Input As #NFDATA2
 ''
 ''Do While Not EOF(NFDATA2)
 ''Line Input #NFDATA2, FFF
 ''If Not FFF = "" Then
 ''ss = ss + 1
 ''codfnl(ss, 1) = FFF
 ''Line Input #NFDATA2, FFF
 ''codfnl(ss, 2) = FFF
 ''End If
 ''
 ''Loop
 ''codfnl(0, 0) = ss
 ''Close #NFDATA2
 ''
 ''
 ''End Sub
 
 Function COD_PIEGA(ByVal CODICE As String, ByVal DISEGNO As String)
 COD_PIEGA = ""
 
 If InStr(1, ANTE_SPC_VTR, DISEGNO) > 0 Then AN_SVTR = "1" Else AN_SVTR = "0" 'PRESENZA DELLO SPACCO VETRO
 
 AN_SPS = Replace(Right(CODICE, 3), "-", "")
 CODICE = Left(CODICE, Len(CODICE) - 3)
 AN_ALT = Right(CODICE, 4)
 CODICE = Left(CODICE, Len(CODICE) - 4)
 AN_PL = Right(CODICE, 3)
 CODICE = Left(CODICE, Len(CODICE) - 3)
 AN_PNCB = Left(CODICE, 2)
 CODICE = Right(CODICE, Len(CODICE) - 2)
 AN_TIPO = CODICE
 
 Select Case AN_SPS
 Case 15 'RIVESTITE
     Select Case AN_TIPO
     Case "TL", "TR"
         COD_PIEGA = "11"
     Case "S"
         If AN_PL = "600" Or AN_PL = "650" Then
             COD_PIEGA = "9"
         Else
             If AN_SVTR = "0" Then
                 COD_PIEGA = "5"
             Else
                 COD_PIEGA = "15"
             End If
         End If
     Case "AD", "AS"
         If AN_PL = "600" Then
             COD_PIEGA = "7"
         Else
             If AN_SVTR = "0" Then
                 COD_PIEGA = "5"
             Else
                 COD_PIEGA = "15"
             End If
         End If
     Case "CC"
         COD_PIEGA = "13"
     End Select
 
 Case 18 'ANTIRUGGINE
     Select Case AN_TIPO
     Case "TL", "TR"
         COD_PIEGA = "12"
     Case "S"
         If AN_PL = "600" Or AN_PL = "650" Then
             COD_PIEGA = "10"
         Else
             COD_PIEGA = "6"
         End If
     Case "AD", "AS"
         If AN_PL = "600" Then
             COD_PIEGA = "8"
         Else
             COD_PIEGA = "6"
         End If
     Case "CC"
         COD_PIEGA = "14"
     End Select
 
 Case Else
 MsgBox ("ERRORE CODICE PIEGA")
 End Select
 
 
 
 End Function
 
 
 Sub WRITE_NEWCODE()
 
 
 
 NFDATA3 = FreeFile
 NF_DAT3 = FNLANTE_FOLDER & "FNL_ANTE1.txt"
 Open NF_DAT3 For Output As #NFDATA3
 
 For AA = 1 To Val(COD_WRITE(0, 0))
 Print #NFDATA3, COD_WRITE(AA, 1)
 Print #NFDATA3, COD_WRITE(AA, 2)
 Next AA
 
 Close #NFDATA3
 
 
 End Sub
 
 Sub UNIFY_FILE()
 
 
 NFDATA33 = FreeFile
 NF_DAT33 = FNLANTE_FOLDER & "FNL_ANTE3.txt"
 Open NF_DAT33 For Output As #NFDATA33
 
 
 NFDATA44 = FreeFile
 NF_DAT44 = FNLANTE_FOLDER & "FNL_ANTE.txt"
 If Dir(NF_DAT44) <> "" Then
 Open NF_DAT44 For Input As #NFDATA44
 
 Do While Not EOF(NFDATA44)
 Line Input #NFDATA44, VVV
 
 Print #NFDATA33, VVV
 Loop
 Close #NFDATA44
 Kill (NF_DAT44)
 End If
 
 
 NFDATA44 = FreeFile
 NF_DAT44 = FNLANTE_FOLDER & "FNL_ANTE1.txt"
 If Dir(NF_DAT44) <> "" Then
 Open NF_DAT44 For Input As #NFDATA44
 
 Do While Not EOF(NFDATA44)
 Line Input #NFDATA44, VVV
 
 Print #NFDATA33, VVV
 Loop
 Close #NFDATA44
 Kill (NF_DAT44)
 End If
 
 Close #NFDATA33
 
 Name NF_DAT33 As FNLANTE_FOLDER & "FNL_ANTE.txt"
 
 
 End Sub