darklife06

PP SL

Oct 24th, 2021 (edited)
432
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Private Sub Workbook_Open()
  2.  
  3. 'Ouverture du fichier NC
  4.  
  5. WBXLS = ActiveWorkbook.Name
  6.  
  7.     ChDrive "D:\"
  8.     ChDir "D:\Bureau"
  9.  
  10.     a = Application.GetOpenFilename("NCFiles (*.NC), *.NC")
  11.    
  12.     Select Case TypeName(a)
  13.     Case Is = "Boolean"
  14.         Exit Sub
  15.     Case Else
  16.     Workbooks.OpenText Filename:=a, Origin:=xlMSDOS, _
  17.         StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
  18.         ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
  19.         , Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
  20.         TrailingMinusNumbers:=True
  21.     End Select
  22.    
  23. WBNC = ActiveWorkbook.Name
  24.  
  25. 'Modif des données
  26.  
  27. i = 1       'init ligne 1
  28. FR = 0
  29.  
  30.     Do While Not Cells(i, 1).Value Like "M30"
  31.         Cells(i, 1).Select
  32.        
  33.         If Cells(i, 1).Value Like "G28 U0 V0 W0" Then
  34.             Cells(i, 1).Value = "G28 U0 W0"
  35.         ElseIf Cells(i, 1).Value Like "T????" Then
  36.             Cells(i, 1).Value = Cells(i, 1).Value & " M41"
  37.             Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
  38.             Cells(i, 1).Value = "M69"
  39.             i = i + 1
  40.         ElseIf Cells(i, 1).Value Like "*M97*" Then
  41.             FR = 1
  42.         ElseIf Cells(i, 1).Value Like "*G49*" Then
  43.             Rows(i).Delete Shift:=xlUp
  44.             i = i - 1
  45.         End If
  46.        
  47.         i = i + 1
  48.     Loop
  49.  
  50. If FR = 1 Then
  51. MsgBox ("M97 détecté, verifier que le M69 ajouté à l'appel d'outil ne doit pas être supprimé ou rebloquer le mandrin après")
  52. End If
  53.  
  54. Debug.Print (WBXLS)
  55. Debug.Print (WBNC)
  56. Debug.Print ("--------")
  57.  
  58. XLClose = 1
  59.  
  60. For Each WB In Application.Workbooks
  61. Debug.Print (WB.Name)
  62. If WB.Name <> WBXLS And WB.Name <> WBNC Then
  63. Debug.Print ("No Match")
  64. XLClose = 0
  65. End If
  66. Next WB
  67.  
  68. Application.DisplayAlerts = False
  69. Workbooks(WBNC).SaveAs a
  70.  
  71. If XLClose = 1 Then
  72. Application.Quit
  73. Else
  74. Workbooks(WBNC).Close
  75. Workbooks(WBXLS).Close
  76. End If
  77.  
  78. End Sub
  79.  
RAW Paste Data