Attribute VB_Name = "ModESAT_FAM_IME1"
Option Explicit

Sub UpdateXLS()
Dim CSVFic As String
Dim CSVUTF8 As String
Dim CSV_Etab()
Dim Intitules()
Dim ligne As String
Dim iEtab As Integer
Dim CSVEtab As String
Dim CSVSplit1 As String
Dim wb As Workbook
Dim ws As Worksheet
Dim bln As Boolean
Dim var
Dim text As String
Dim j As Integer
ReDim CSV_Etab(20 * 3)

CSV_Etab() = Array( _
"Etab", "fichier", "", _
"SAJ Aline Gaudet", "Saj.xls", "SAJ", _
"ESAT Les Ecluses", "Ecluses.xls", "Ecluses", _
"ESAT Rive Gauche", "Rive Gauche.xls", "Rive Gauche", _
"IME Le Rocher Fleuri", "IME.xls", "IME Midi", _
"IME A - Jonquille", "IME.xls", "IME A Jonquille", _
"IME B - Anis", "IME.xls", "IME B Anis", _
"IME C - Clémentine", "IME.xls", "IME C Clémentine", _
"Foyer Occupationnel L'Etoile B", "Etoile.xls", "Etoile B", _
"Foyer Occupationnel L'Etoile C", "Etoile.xls", "Etoile C", _
"Foyer Occupationnel L'Etoile D", "Grillons.xls", "Grillons D1", _
"Foyer Hébergement Les caravelles 1 - Vert", "Caravelles.xls", "CAR 1", _
"Foyer Hébergement Les caravelles 2 - Blanc", "Caravelles.xls", "CAR 2", _
"Foyer Hébergement Les caravelles 3 - Bleu", "Caravelles.xls", "CAR 3", _
"FAM Eglantine 1 - Jaune", "FAM.xls", "Eglantine Jaune", _
"FAM Eglantine 2 - Vert", "FAM.xls", "Eglantine Vert", _
"FAM Eglantine 3 - Rose", "FAM.xls", "Eglantine Rose", _
"FAM Eglantine 4 - Blanc", "FAM.xls", "Eglantine Blanc")

'le tableau des intitulés ne servent pas,  il est a remarquer que
'les trois premiers intitulés dans le fichier CSV sont précédés de Repas
' ce qui conduit à supprimer le mot Repas dans la recherche des lignes du fichier Excel
ReDim Intitules(19)
Intitules() = Array( _
"Normal", _
"Régime", _
"Sans sel", _
"Repas diabétique", _
"Repas sans porc", _
"Veilleur de nuit", _
"Veilleur de nuit sans porc", _
"Plateau repas froid", _
"Plateau repas de formation", _
"Divers", _
"Pique nique", _
"Sans poisson", _
"Supplément Féculent", _
"Régime S/Porc", _
"Reg Sans crudité", _
"Reg Sans choux", _
"Diabétique Sans Poisson", _
"Sans Choux", _
"Sans crudité")

ChDir ThisWorkbook.Path
Application.DisplayAlerts = False


CSVFic = Application.GetOpenFileName("Fichiers csv (*.csv), *.csv")
CSVUTF8 = Replace(LCase(CSVFic), ".csv", ".utf8")
text = ReadUTF8(CSVFic)
Open CSVUTF8 For Output As #1
Print #1, text
Close #1
Open CSVUTF8 For Input As #1
Line Input #1, ligne
While Not EOF(1)
If Split(ligne, ";")(0) = "ETABLISSEMENT" Then
  iEtab = 1
  Do
    CSVEtab = CStr(CSV_Etab(3 * iEtab))
    'Call DebugStr(CSVEtab)
    If InStr(1, ligne, "mentin") Then ligne = ligne 'Decode_UTF8(ligne)
    CSVSplit1 = CStr(Split(ligne, ";")(1))
    'Call DebugStr(CSVSplit1)
    If UCase(CSVEtab) = UCase(CSVSplit1) Then
      Exit Do
    End If
    iEtab = iEtab + 1
  Loop Until iEtab = 18
  
  If iEtab < 18 And Not EOF(1) Then
    Set oFso = CreateObject("Scripting.FileSystemObject")
    If oFso.FileExists(ThisWorkbook.Path & "\" & CSV_Etab(3 * iEtab + 1)) Then
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & CSV_Etab(3 * iEtab + 1))
    'CSV_Etab(3 * iEtab + 2) = Replace(CSV_Etab(3 * iEtab + 2), "1", " 1")
    Set ws = wb.Sheets(CSV_Etab(3 * iEtab + 2))
    ws.Activate
    Line Input #1, ligne
    Do
       Dim intitule
       intitule = Split(ligne, ";")(0)
       text = Split(ligne, ";")(1)
       If InStr(1, text, "Repas Normal") = 1 Or InStr(1, text, "Repas Régime") = 1 Or InStr(1, text, "Repas Sans sel") = 1 Then text = Replace(text, "Repas ", "")  '"Repas " & text '
       If InStr(1, text, "Repas hors délai") = 1 Then text = "Repas Hors délai"
       If text <> "" Then
         var = Application.match(text, ws.Columns(2), 0)
         If VBA.IsError(var) = False And CInt(var) <> 0 Then
         If LCase(text) = "repas hors délai" And Len(CStr(var)) < 9 Then var = var + 1
         If text <> "Total" Then
            For j = 0 To 6  'Midi et soir
            ws.Cells(CLng(var), 6 + 4 * j) = Split(ligne, ";")(2 + j)
            ws.Cells(CLng(var), 8 + 4 * j) = Split(ligne, ";")(3 + j)
            Next
        End If
         End If
       End If
       Line Input #1, ligne
       If ligne = "" Then
       text = ""
       Else
       text = Split(ligne, ";")(1)
        End If
    Loop Until text = ""
   Application.DisplayAlerts = False

 
    wb.Close SaveChanges:=True
    End If
 
  End If
Else
  text = Split(ligne, ";")(0)
  While text <> ""
    Line Input #1, ligne
  text = Split(ligne, ";")(0)
  
  Wend
End If
If Not EOF(1) Then Line Input #1, ligne
Wend
Close #1
Application.DisplayAlerts = True
MsgBox "Terminé"
End Sub


Function ReadUTF8(file As String)
    Dim ws As Worksheet
    Dim strText As String
    Dim intRow
    Dim strLine
    If file = "Faux" Then
    Else
    ' read utf-8 file to strText variable
   With CreateObject("ADODB.Stream")
        .Open
        .Type = 1  ' Private Const adTypeBinary = 1
        .LoadFromFile file
        .Type = 2  ' Private Const adTypeText = 2
        .Charset = "utf-8"
        strText = .ReadText(-1)  ' Private Const adReadAll = -1
    End With
    End If
    ReadUTF8 = strText
End Function