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
| Private Sub CommandButton11_Click()
'essai script Acad reperes
Unload UserForm3
numfic = FreeFile()
Dim xLoc, xrep, xmat, xligne, xligne2 As String
xligne = 0
Dim lignelue As Integer
Open "e:\1 - AFF\aa divers novorest\00 - gestion affaires\00 base\modeles\essai.scr" For Output As #numfic
With ActiveSheet
lignelue = 4
While Not IsEmpty(.Cells(lignelue, 1))
xLoc = ActiveSheet.Cells(lignelue, 1).Value
xmat = ActiveSheet.Cells(lignelue, 2).Value
xrep = ActiveSheet.Cells(lignelue, 3).Value
xligne = xligne + 0.2
xligne2 = Replace(xligne, ",", ".")
Print #numfic, "TEXTE 0," & xligne2 & " 0.15 0 " & xLoc
Print #numfic, "TEXTE 4," & xligne2 & " 0.15 0 " & xrep
Print #numfic, "TEXTE 5," & xligne2 & " 0.15 0 " & xmat
lignelue = lignelue + 1
Wend
'Ferme et save As
Dim datejour As String
datejour = Format(Now, "yyyy mm dd")
Dim retour As String
retour = Workbooks("NovoMaterModele.xls").Worksheets("listemater").Range("BB1").Value
Dim fichier As String
fichier = retour & " ESSAI SCR " & datejour & ".scr"
'MsgBox (fichier)
SaveAs #numfic "e:\" & fichier
'Close #numfic ' Ferme le fichier.
End With
End Sub |
Partager