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
| Public Sub Creationtxt()
Dim l_Ligne As Integer
Dim l_OutputLine As Integer
Call CreateWorksheet(cSheetOutputs)
Call SelectSheet(cSheetInputs)
l_Ligne = cFirstLine
Worksheets(cSheetOutputs).Cells(1, 1) = "<CECI EST LE CODE"?>"
Worksheets(cSheetOutputs).Cells(3, 1) = "<A TRANSMETTRE">"
Worksheets(cSheetOutputs).Cells(4, 1) = " <VALEUR type=""text"">"
Do While (IsCellEmpty(l_Ligne, cColumnA) = False)
l_OutputLine = PrintCreatetxt(l_Ligne)
l_Ligne = l_Ligne + 1
Loop
MsgBox l_Ligne
Worksheets(cSheetOutputs).Cells(l_OutputLine + 1, 1) = " </FIN>"
Worksheets(cSheetOutputs).Cells(l_OutputLine + 2, 1) = "</FIN>"
End Sub
Private Function PrintCreatetxt(p_Line As Integer) As Integer
Dim l_OutputLine As Integer
Dim l_Dn As String
l_Dn = Worksheets(cSheetInputs).Cells(p_Line, cColumnDN)
l_OutputLine = ((p_Line - 2) * cNbLinePerBloc) + 5
'Worksheets(cSheetOutputs).Cells(l_OutputLine, 1) = "<?VERSION?>"
'Worksheets(cSheetOutputs).Cells(l_OutputLine , 1) = "<!valeur'>"
'Worksheets(cSheetOutputs).Cells(l_OutputLine + 2, 1) = "<et">"
'Worksheets(cSheetOutputs).Cells(l_OutputLine + 3, 1) = "<et">"
Call PrintCreateDN(p_Line, l_OutputLine)
PrintCreatetxt = l_OutputLine
End Function
Private Sub PrintCreateDN(p_inputLine As Integer, p_outputLine As Integer)
Dim l_BTS As Integer
Dim l_a As String
Dim l_b As Integer
Dim l_c As Integer
l_a = Worksheets(cSheetInputs).Cells(p_inputLine, cColumna)
l_b = Worksheets(cSheetInputs).Cells(p_inputLine, cColumnb)
l_c = Worksheets(cSheetInputs).Cells(p_inputLine, cColumnc)
l_d = Worksheets(cSheetInputs).Cells(p_inputLine, cColumnd)
Worksheets(cSheetOutputs).Cells(p_outputLine, cColumnDN) = " <class=""A"" et=""20"" dir=""val-" & a & "/a-" & b & "/b-" & c & "/c" & d & """ operation=""fin""/>"
End Sub
Private Sub CreateWorksheet(ByRef p_Name)
DeleteWorksheet (p_Name)
Sheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = p_Name
End Sub
Private Sub DeleteWorksheet(ByRef p_Name)
Application.DisplayAlerts = False
On Error Resume Next
Sheets(p_Name).Delete
Application.DisplayAlerts = True
End Sub
Private Sub SelectSheet(ByRef p_Name)
Sheets(p_Name).Activate
End Sub
Private Function IsCellEmpty(p_Line As Integer, p_column As Integer) As Boolean
If (Len(Cells(p_Line, p_column)) > 0) Then
IsCellEmpty = False
Else
IsCellEmpty = True
End If
End Function |
Partager