Sub CreateExcelFile()
StrCurrency = "EUR"
frmMSGeneral3D.Show
End Sub
Sub CreateExcelFile_Go(language, CodeRow, DateCol, WorkerCol, _
Level1Col, Level1Def, Level2Col, Level2Def, _
Level3Col, Level3Def, AmountRow, AmountCol, _
TpWorkRow, TpWorkCol, TpLvl1Row, TpLvl1Col, _
TpLvl2Row, TpLvl2Col, TpLvl3Row, TpLvl3Col, _
RSelCol, CSelRow, SSelTxt)
NbSht = Worksheets.Count
'Euro-Bef****************************************
Dim iNbDeci As Integer
If StrCurrency = "BEF" Then
iNbDeci = 2
Else
iNbDeci = 4
End If
'Euro-Bef****************************************
Set XL = Sheets.Add(Sheets(1))
XL.Name = "Saiau-Excel"
Call SaiauTitles(XL, language)
XLRow = 2
For k = 1 To NbSht
Set SI = Sheets(k + 1)
If SSelTxt = "" Then
GetInfoSht = True
Else
If UCase(Left(SI.Name, Len(SSelTxt))) <> UCase(SSelTxt) Then
GetInfoSht = True
Else
GetInfoSht = False
End If
End If
If GetInfoSht Then
If TpWorkRow <> 0 Then
workerinf = SI.Cells(TpWorkRow, TpWorkCol)
End If
If TpLvl1Row <> 0 Then
Level1Inf = SI.Cells(TpLvl1Row, TpLvl1Col)
End If
If TpLvl2Row <> 0 Then
Level2Inf = SI.Cells(TpLvl2Row, TpLvl2Col)
End If
If TpLvl3Row <> 0 Then
Level3Inf = SI.Cells(TpLvl3Row, TpLvl3Col)
End If
Set Tbl = SI.Cells(AmountRow, AmountCol).CurrentRegion
' Lc le 3/12/2008
'NbRow = Tbl.Rows.Count - (AmountRow - 1)
NbRow = Tbl.Rows.Count - 1
NbCol = Tbl.Columns.Count - (AmountCol - 1)
For i = 0 To (NbRow - 1)
If RSelCol = 0 Then
GetInfoRow = True
Else
If SI.Cells(i + AmountRow, RSelCol) = "" Then
GetInfoRow = True
Else
GetInfoRow = False
End If
End If
If GetInfoRow Then
If SI.Cells(i + AmountRow, DateCol) <> "" Then
DateInf = CDate(SI.Cells(i + AmountRow, DateCol))
End If
If WorkerCol <> 0 Then
If SI.Cells(i + AmountRow, WorkerCol) <> "" Then
workerinf = SI.Cells(i + AmountRow, WorkerCol)
Else
If TpWorkRow <> 0 Then
workerinf = SI.Cells(TpWorkRow, TpWorkCol)
End If
End If
End If
If Level1Col <> 0 Then
If SI.Cells(i + AmountRow, Level1Col) <> "" Then
Level1Inf = SI.Cells(i + AmountRow, Level1Col)
Else
If TpLvl1Row <> 0 Then
Level1Inf = SI.Cells(TpLvl1Row, TpLvl1Col)
End If
End If
End If
If Level2Col <> 0 Then
If SI.Cells(i + AmountRow, Level2Col) <> "" Then
Level2Inf = SI.Cells(i + AmountRow, Level2Col)
Else
If TpLvl2Row <> 0 Then
Level2Inf = SI.Cells(TpLvl2Row, TpLvl2Col)
End If
End If
End If
If Level3Col <> 0 Then
If SI.Cells(i + AmountRow, Level3Col) <> "" Then
Level3Inf = SI.Cells(i + AmountRow, Level3Col)
Else
If TpLvl3Row <> 0 Then
Level3Inf = SI.Cells(TpLvl3Row, TpLvl3Col)
End If
End If
End If
For j = 0 To (NbCol - 1)
If SI.Cells(i + AmountRow, j + AmountCol) = "" Then
GetInfoCell = False
Else
If CSelRow = 0 Then
GetInfoCell = True
Else
If SI.Cells(CSelRow, j + AmountCol) = "" Then
GetInfoCell = True
Else
GetInfoCell = False
End If
End If
End If
If GetInfoCell And workerinf Then ' F55 07/03/2024
XL.Cells(XLRow, 1) = workerinf
XL.Cells(XLRow, 2) = DateInf
XL.Cells(XLRow, 3) = SI.Cells(CodeRow, j + AmountCol)
'************************************************
' B.Maes 20/08/2003
' Put numeric display format on result cell.
XL.Cells(XLRow, 4).NumberFormat = "0.00"
' B.Maes 20/08/2003
' By multiplying the contents of the cell by 1, we force a numeric result in the SAIAU-sheet.
' XL.Cells(XLRow, 4) = Application.Round(SI.Cells(i + AmountRow, j + AmountCol) * 1, 2)
valeur = Trim(SI.Cells(i + AmountRow, j + AmountCol))
If valeur = "" Then valeur = 0
XL.Cells(XLRow, 4) = Application.Round(valeur * 1, 2)
'************************************************
If Level1Col <> 0 Then
XL.Cells(XLRow, 5) = Level1Inf
Else
If TpLvl1Row <> 0 Then
XL.Cells(XLRow, 5) = Level1Inf
Else
XL.Cells(XLRow, 5) = Level1Def
End If
End If
If Level2Col <> 0 Then
XL.Cells(XLRow, 6) = Level2Inf
Else
If TpLvl2Row <> 0 Then
XL.Cells(XLRow, 6) = Level2Inf
Else
XL.Cells(XLRow, 6) = Level2Def
End If
End If
If Level3Col <> 0 Then
XL.Cells(XLRow, 7) = Level3Inf
Else
If TpLvl3Row <> 0 Then
XL.Cells(XLRow, 7) = Level3Inf
Else
XL.Cells(XLRow, 7) = Level3Def
End If
End If
XL.Cells(XLRow, 14) = StrCurrency
XLRow = XLRow + 1
End If
Next j
End If
Next i
End If
Next k
For i = 1 To 18
Columns(i).EntireColumn.AutoFit
Next i
End Sub
Sub Automatic()
CreateExcelFile
If OkButton Then
CreateTextFile
End If
End Sub
