1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
| Dim TrouveRMA As Range
Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
xlApp.Visible = True
Dim strWorkbookName As String
strWorkbookName = "V:\s6_mqp\Stagiaire\Louis DONIN\F5\RMA\CRE\Nouveau dossier\CRE.xls"
Dim xlBook As Excel.Workbook
Set xlBook = xlApp.Workbooks.Open(FileName:=strWorkbookName)
Dim xlSheet As Excel.Worksheet
Set xlSheet = xlBook.Sheets("Feuil1")
Dim derniereligne As Long, nouvellelign As Long
Dim RMA_Cherche As String
Dim Incrementation As Variant
RMA_Cherche = NumRMAbox.Text
With xlSheet.Range("E:E")
Set TrouveRMA = .Cells.Find(what:=RMA_Cherche, LookAt:=xlPart)
If TrouveRMA Is Nothing Then
derniereligne = xlSheet.Range("C" & xlSheet.Rows.Count).End(xlUp).Row + 1
xlSheet.Cells(derniereligne, 1).Value = DeptReparation
xlSheet.Cells(derniereligne, 3).Value = PN & "-" & SN
xlSheet.Cells(derniereligne, 5).Value = NumRMA
xlSheet.Cells(derniereligne, 4).Value = WHO
derniereligne = xlSheet.Range("B" & xlSheet.Rows.Count).End(xlUp).Row
nouvelleligne = xlSheet.Range("B" & xlSheet.Rows.Count).End(xlUp).Row + 1
Incrementation = xlSheet.Cells(derniereligne, 2).Value
Dim stPLettre As String 'partie inchangée du CRE
Dim iPrecNum As Variant 'Numero précédent
iPrecNum = Left(Incrementation, 4) 'Extraction Numéro..
xlSheet.Cells(nouvelleligne, 2).Value = Format(iPrecNum + 1, "0000") & "-" & DeptReparation & "-" & PN & "-" & SN & "-" & OF
For Each controle In ActiveDocument.ContentControls
If controle.Title = "NumCRE" Then
controle.Range.Text = xlSheet.Cells(nouvelleligne, 2).Value
numCRE = controle.Range.Text
End If
Next
Dim strTime, chemin_F52, chemin_F54, chemin_F1, chemin_F2, chemin_F4 As String
strTime = Format(Now, "yyyy")
chemin_F1 = "V:\s6_mqp\Stagiaire\Louis DONIN\F5\RMA\CRE\Nouveau dossier\F1\"
chemin_F2 = "V:\s6_mqp\Stagiaire\Louis DONIN\F5\RMA\CRE\Nouveau dossier\F2\"
chemin_F4 = "V:\s6_mqp\Stagiaire\Louis DONIN\F5\RMA\CRE\Nouveau dossier\F4\"
chemin_F52 = "V:\s6_mqp\Stagiaire\Louis DONIN\F5\RMA\CRE\Nouveau dossier\F52\A Valider\" & strTime & "\"
chemin_F54 = "V:\s6_mqp\Stagiaire\Louis DONIN\F5\RMA\CRE\Nouveau dossier\F54\A Valider\" & strTime & "\"
If DeptReparation = "F1" Then
ActiveDocument.SaveAs FileName:=chemin_F1 & numCRE & "-" & strTime, FileFormat:=wdFormatFlatXMLMacroEnabled
ElseIf DeptReparation = "F2" Then
ActiveDocument.SaveAs FileName:=chemin_F2 & numCRE & "-" & strTime, FileFormat:=wdFormatFlatXMLMacroEnabled
ElseIf DeptReparation = "F4" Then
ActiveDocument.SaveAs FileName:=chemin_F4 & numCRE & "-" & strTime, FileFormat:=wdFormatFlatXMLMacroEnabled
ElseIf DeptReparation = "F52" Then
ActiveDocument.SaveAs FileName:=chemin_F52 & numCRE & "-" & strTime, FileFormat:=wdFormatFlatXMLMacroEnabled
xlSheet.Hyperlinks.Add Anchor:=xlSheet.Cells(nouvelleligne, 2), Address:=chemin_F52 & xlSheet.Cells(nouvelleligne, 2).Value & "-" & strTime & ".xml"
ElseIf DeptReparation = "F54" Then
ActiveDocument.SaveAs FileName:=chemin_F54 & numCRE & "-" & strTime, FileFormat:=wdFormatFlatXMLMacroEnabled
End If
'xlBook.Save
xlBook.Close
Else
Msgbox "Répertoire déjà rempli avec ce CRE"
xlBook.Close
End If
End With
Set TrouveRMA = Nothing
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing |
Partager