'Module_MajBase
Option Explicit
Option Base 1

Sub MajBase()
Application.ScreenUpdating = False
  Dim tbBase(), tbPeche(), arrPeche()
  Dim i%, j%, nr%, nc%
  Dim id$, nomPl$
  Dim ctrl As Boolean, ctrlPeche As Boolean
  Dim ch As Range
  Dim pl As Variant
  
  Sheets("Saisie").ListObjects("tb_Peche").ShowTotals = False
  tbPeche = Range("tb_Peche[#all]").Value2
  Sheets("Saisie").ListObjects("tb_Peche").ShowTotals = True
  nc = UBound(tbPeche) - 2
  ReDim arrPeche(UBound(tbPeche))
  tbBase = Range("tb_Base").Value2
  
'Construit l'identifiant de la pche du jour
  id = "id" & Range("Date").Value2 & Range("Heure_debut").Value2
  id = Range("Date").Value2 & "|" & Range("Meteo").Value2 & "|" & Range("Riviere").Value2 & "|" & _
        Range("Secteur").Value2 & "|" & Range("Leurre_type").Value2 & "|" & Range("Leurre_categorie").Value2 & "|" & _
        Range("Leurre_couleur").Value2
  
'Cherche si l'identifiant existe dj dans la base et demande s'il faut le modifier
  With Range("tb_Base[Id]")
      Set ch = .Find(id, LookIn:=xlValues)
      If Not ch Is Nothing Then
        If MsgBox("Cette ligne existe dj" & Chr(10) & "Faut il la modifier?", vbYesNo + vbCritical) = vbNo Then
          Exit Sub
        Else
          Call RecupExistantBase(id)
        'Supprime les donnes anciennes pour pouvoir les remplacer par les nouvelles
          For i = UBound(tbBase) To 1 Step -1
            If tbBase(i, 1) = id Then Range("tb_Base").Rows(i).EntireRow.Delete
          Next i
          If MsgBox("Faut il enregistrer les nouvelles donnes?", vbYesNo + vbCritical) = vbNo Then
            Call RazTbPeche
            Exit Sub
          End If
        End If
      End If
  End With
  
  For i = 2 To UBound(tbPeche, 2)
  'Pour chaque espce du tableau de saisie
    For j = 2 To UBound(tbPeche) ' - 1
      'Si au moins un poisson a t pris on contruit un array
      If tbPeche(j, i) <> "" Then
        ctrl = True: ctrlPeche = True 'Contrle de retour non capot
        arrPeche(1) = tbPeche(1, i)
        arrPeche(j) = tbPeche(j, i)
      End If
    Next j
    If ctrl = True Then
      Call AjoutLigneBase
      For Each pl In ThisWorkbook.Names
        If Split(pl.RefersTo, "$")(0) = "=Saisie!" Then
          nomPl = pl.Name
          nr = Range("tb_Base").Rows.Count
          Range("tb_Base[" & nomPl & "]").Rows(nr) = Range(nomPl).Value2 'On crit les donnes hors tableau
        End If
      Next pl
      
      With Range("tb_Base[#headers]")
      'Cherche le numro de la colonne "Espece" dans la base
        For j = 1 To Range("tb_Base[#headers]").Columns.Count
          If Range("tb_Base[#headers]").Cells(1, j) = "Espece" Then nc = j
        Next j
      End With
      
      Range("tb_Base[Id]").Rows(nr) = id
      For j = 1 To UBound(arrPeche)
        Range("tb_Base").Cells(nr, j + (nc - 1)) = arrPeche(j)
        arrPeche(j) = Empty
      Next j
    End If
    ctrl = False
  Next i
  
  If ctrlPeche = False Then
    Call AjoutLigneBase
    nr = Range("tb_Base").Rows.Count
    Range("tb_Base[Id]").Rows(nr) = id
    For Each pl In ThisWorkbook.Names
      If Split(pl.RefersTo, "$")(0) = "=Saisie!" Then
        nomPl = pl.Name
        nr = Range("tb_Base").Rows.Count
        Range("tb_Base[" & nomPl & "]").Rows(nr) = Range(nomPl).Value2
      End If
    Next pl
  End If

  Range("tb_Base[Duree]").FormulaR1C1 = "=([@[Heure_fin]]-[@[Heure_debut]])*24" ' Insre formule de calcul de la dure
  Range("tb_Base[Total_espece]").FormulaR1C1 = "=SUM(tb_Base[@[0 - 19 cm]:[240 - 249 cm]])" ' Insre formule de calcul du total par espce
  
  ActiveWorkbook.Worksheets("Base").ListObjects("tb_Base").Sort.SortFields.Clear
  ActiveWorkbook.Worksheets("Base").ListObjects("tb_Base").Sort.SortFields.Add _
      Key:=Range("tb_Base[[#All],[Date]]"), SortOn:=xlSortOnValues, Order:= _
      xlAscending, DataOption:=xlSortTextAsNumbers
  With ActiveWorkbook.Worksheets("Base").ListObjects("tb_Base").Sort
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
  End With
  
  Call RazTbPeche
  
Application.ScreenUpdating = True
End Sub

Sub AjoutLigneBase()
  Dim nr%, nc%
  Dim tb()
  Dim base$
  
  base = "tb_base"
  tb = Range(base).Value2
  nr = Range(base).Rows.Count
  nc = Range(base).Columns.Count
  Sheets("Base").ListObjects(base).ShowTotals = False
  Range(base).Resize(nr + 1, nc) = tb
  Range(base).Rows(nr + 1) = ""
  Sheets("Base").ListObjects(base).ShowTotals = True

End Sub

Sub FiltrerEspeces(espece)
' Filtre le tableau de saisie suivant l'espce choisie
Application.ScreenUpdating = False
  Dim Sh As Worksheet
  Dim c As Range
  Dim esp$
  Dim nbC%, dc%, pc%, nc%, i%
  
  Set Sh = Sheets("Saisie")
  nbC = Range("tb_Peche").Columns.Count
  dc = Range("tb_Peche").Columns(nbC).Column
  pc = dc - nbC + 1
  
  Sh.Range(Columns(pc), Columns(dc)).EntireColumn.Hidden = False
  
  If espece <> "Afficher tout" Then
    With Sh.Range("tb_Peche[#headers]")
      Set c = .Find(espece, LookIn:=xlValues)
      If Not c Is Nothing Then
        nc = c.Column
        Sh.Range(Columns(pc + 1), Columns(dc)).EntireColumn.Hidden = True
        Sh.Columns(nc).EntireColumn.Hidden = False
        nc = nc - pc + 1
      End If
    End With
  End If
  
Application.ScreenUpdating = True
End Sub
