Private Sub CommandButton1_Click()
If Application.CountA(Range("D4:D50")) > 0 Then
If CopieBlocNote Then
MsgBox "Les données des lignes cochées, ont bien été transférées à Copilote"
ThisWorkbook.Save
Application.Quit
End If
Else
MsgBox "Veuillez cocher les lignes des références à transférer à Copilote, en colonne D"
End If
End Sub
Function CopieBlocNote() As Boolean
Dim fs
Dim EcrireFichier As Boolean
Dim WkDat As Workbook
Application.ScreenUpdating = False
Set WkDat = Workbooks.Add
With ThisWorkbook.Sheets(1)
.Range("L2").FormulaR1C1 = "=RC[-11]&""00""&RC[-10]&REPT("" "",18-LEN(RC[-10]))&TEXT(RC[-9],""00000000"")&"" ""&RC[-8]&REPT("" "",113-LEN(RC[-8]))&RC[-7]&REPT("" "",11-LEN(RC[-7]))" _
& "&RC[-6]&REPT("" "",11-LEN(RC[-6]))&MID(RC[-5],1,40)&REPT("" "",40-LEN(MID(RC[-5],1,40)))&RC[-4]&REPT("" "",12-LEN(RC[-4]))" _
& "&RC[-3]&REPT("" "",20-LEN(RC[-3]))&RC[-2]&REPT("" "",7-LEN(RC[-2]))&RC[-1]&REPT("" "",16-LEN(RC[-1]))"
With .Range("L2:L" & .Range("A65536").End(xlUp).Row)
If ThisWorkbook.Sheets(1).Range("G3") <> "" Then .FillDown
'.FillDown
.Calculate
.Copy
WkDat.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValues
.ClearContents
End With
EcrireFichier = True
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.fileexists("C:\temp" & "\" & .Range("A1").Value & ".txt") Then
If MsgBox("Le Fichier 'C:\temp" & "\" & .Range("A1").Value & ".txt' existe deja." & vbCrLf & "Vouslez-vous l'écraser?", vbYesNo) = vbYes Then
Kill "C:\temp" & "\" & .Range("A1").Value & ".txt"
Else
EcrireFichier = False
End If
End If
If EcrireFichier Then
WkDat.SaveAs Filename:="C:\temp" & "\" & .Range("A1").Value & ".txt", FileFormat:=xlText
End If
WkDat.Close savechanges:=False
End With
Set WkDat = Nothing
CopieBlocNote = EcrireFichier
End Function