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", "CAR1", _
"Foyer Hébergement Les caravelles 2 - Blanc", "Caravelles.xls", "CAR2", _
"Foyer Hébergement Les caravelles 3 - Vert", "Caravelles.xls", "CAR3", _
"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

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))
    Line Input #1, ligne
    Do
       Dim intitule
       intitule = Split(ligne, ";")(0)
       text = Split(ligne, ";")(1)
       If InStr(1, text, "Repas") = 1 Then text = Replace(text, "Repas ", "")
       If text <> "" Then
         var = Application.match(text, ws.Columns(2), 0)
         If Not VBA.IsError(var) Then
            For j = 0 To 6 Step 2 'Midi et soir
            Cells(CLng(var), 6 + 4 * j) = Split(ligne, ";")(2 + j)
            Cells(CLng(var), 8 + 4 * j) = Split(ligne, ";")(3 + j)
            Next
            Exit Do
         End If
       End If
       Line Input #1, ligne
       text = Split(ligne, ";")(1)
    Loop Until text = ""
    wb.Close SaveChanges:=True
    End If
 
  End If
End If
Line Input #1, ligne
Wend
Close #1
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