Sub MAJ_BDD_IM()
' Étape 1 : Retrouver le Tableau "BDD_IM"
Dim ws As Worksheet
Dim tbl As ListObject
Dim tableauTrouve As Boolean
tableauTrouve = False
' Parcourir toutes les feuilles du classeur
For Each ws In ThisWorkbook.Worksheets
' Parcourir tous les objets de liste (tables) dans chaque feuille
For Each tbl In ws.ListObjects
If tbl.Name = "BDD_IM" Then
tableauTrouve = True
Exit For
End If
Next tbl
If tableauTrouve Then Exit For
Next ws
' Vérifier si le tableau a été trouvé
If tableauTrouve Then
MsgBox "Tableau trouvé"
' Étape 2 : Chercher la cellule "Date de début" dans tout le tableau
Dim celluleDateDebut As Range
Dim colonneDateDebutIndex As Integer
Dim derniereValeurDateDebut As Variant
Dim cell As Range
Set celluleDateDebut = Nothing
' Rechercher la cellule "Date de début" dans tout le tableau
On Error Resume Next
For Each cell In tbl.Range
If cell.Value = "Date de début" Then
Set celluleDateDebut = cell
Exit For
End If
Next cell
On Error GoTo 0
' Vérifier si la cellule a été trouvée
If Not celluleDateDebut Is Nothing Then
colonneDateDebutIndex = celluleDateDebut.Column - tbl.Range.Cells(1, 1).Column + 1
MsgBox "Cellule 'Date de début' trouvée dans la colonne " & colonneDateDebutIndex
' Trouver la dernière valeur non vide de cette colonne
Dim colRange As Range
Dim i As Long
Set colRange = tbl.ListColumns(colonneDateDebutIndex).DataBodyRange
For i = colRange.Rows.Count To 1 Step -1
If Not IsEmpty(colRange.Cells(i, 1).Value) Then
derniereValeurDateDebut = colRange.Cells(i, 1).Value
Exit For
End If
Next i
' Vérifier si la dernière valeur correspond à la date d'hier
Dim dateHier As Date
dateHier = Date - 1
' Remplir les dates manquantes jusqu'à la date d'hier
Do While derniereValeurDateDebut < dateHier
i = i + 1
colRange.Cells(i, 1).Value = DateAdd("d", 1, derniereValeurDateDebut)
derniereValeurDateDebut = colRange.Cells(i, 1).Value
Loop
MsgBox "La dernière valeur ajustée à la date d'hier est : " & derniereValeurDateDebut
' Déterminer la dernière ligne non vide dans la colonne "Date de début"
Dim derniereLigne As Long
derniereLigne = colRange.Cells(i, 1).Row
' Récupérer la ligne de la cellule "Tag PI"
Dim ligneTagPI As Long
Dim celluleTagPI As Range
Set celluleTagPI = Nothing
On Error Resume Next
For Each cell In tbl.Range
If cell.Value = "Tag PI" Then
Set celluleTagPI = cell
Exit For
End If
Next cell
On Error GoTo 0
If Not celluleTagPI Is Nothing Then
ligneTagPI = celluleTagPI.Row - tbl.Range.Cells(1, 1).Row + 1
MsgBox "Cellule 'Tag PI' trouvée à la ligne " & ligneTagPI
Else
MsgBox "Cellule 'Tag PI' non trouvée"
Exit Sub
End If
' Étape 3 : Récupérer la ligne de la cellule "Type de calcul"
Dim ligneTypeCalcul As Long
Dim celluleTypeCalcul As Range
Set celluleTypeCalcul = Nothing
On Error Resume Next
For Each cell In tbl.Range
If cell.Value = "Type de calcul" Then
Set celluleTypeCalcul = cell
Exit For
End If
Next cell
On Error GoTo 0
If Not celluleTypeCalcul Is Nothing Then
ligneTypeCalcul = celluleTypeCalcul.Row - tbl.Range.Cells(1, 1).Row + 1
MsgBox "Cellule 'Type de calcul' trouvée à la ligne " & ligneTypeCalcul
Else
MsgBox "Cellule 'Type de calcul' non trouvée"
Exit Sub
End If
' Configuration de l'add-in PI DataLink
Dim addIn As COMAddIn
Dim automationObject As Object
On Error Resume Next
Set addIn = Application.COMAddIns("PI DataLink")
On Error GoTo 0
If Not addIn Is Nothing Then
Set automationObject = addIn.Object
MsgBox "PI DataLink add-in trouvé"
Else
MsgBox "PI DataLink add-in non trouvé"
Exit Sub
End If
' Étape 4 : Parcourir chaque cellule vide du tableau et la remplacer par "Vide"
Dim r As Range
Dim premiereCelluleVideTrouvee As Boolean
premiereCelluleVideTrouvee = False
For Each r In tbl.DataBodyRange
If IsEmpty(r.Value) Then
' Récupérer les valeurs des arguments
Dim arg1 As String, arg2 As String, arg3 As String
Dim arg4 As String, arg5 As String, arg6 As Variant
Dim arg7 As Variant, arg8 As Variant, arg9 As String
' Construire les références des arguments
arg1 = tbl.DataBodyRange.Cells(ligneTagPI, r.Column).Address(RowAbsolute:=True, ColumnAbsolute:=True)
arg2 = tbl.DataBodyRange.Cells(r.Row, 1).Address(RowAbsolute:=True, ColumnAbsolute:=True)
arg3 = tbl.DataBodyRange.Cells(r.Row, 2).Address(RowAbsolute:=True, ColumnAbsolute:=True)
' Déterminer la valeur de l'argument 4
Dim typeCalcul As String
typeCalcul = tbl.DataBodyRange.Cells(ligneTypeCalcul, r.Column).Value
If typeCalcul = "total" Then
arg4 = "total"
ElseIf typeCalcul = "moyenne" Then
arg4 = "average (time-weighted)"
Else
arg4 = "" ' Mettre une valeur par défaut ou ignorer cette cellule
End If
' Définir les autres arguments
arg5 = "time-weighted"
arg6 = 0
arg7 = 1
arg8 = 0
arg9 = "" ' Argument vide
If arg1 <> "" And arg2 <> "" And arg3 <> "" And arg4 <> "" Then
' Afficher les arguments pour la première cellule vide trouvée
If Not premiereCelluleVideTrouvee Then
MsgBox "Arguments pour la première cellule vide trouvée:" & vbCrLf & _
"arg1: " & arg1 & vbCrLf & _
"arg2: " & arg2 & vbCrLf & _
"arg3: " & arg3 & vbCrLf & _
"arg4: " & arg4 & vbCrLf & _
"arg5: " & arg5 & vbCrLf & _
"arg6: " & arg6 & vbCrLf & _
"arg7: " & arg7 & vbCrLf & _
"arg8: " & arg8 & vbCrLf & _
"arg9: " & arg9
premiereCelluleVideTrouvee = True
End If
' Construire la formule
Dim formule As String
formule = "=PIAdvCalcVal(" & _
arg1 & "; " & _
arg2 & "; " & _
arg3 & "; " & _
"""" & arg4 & """; " & _
"""" & arg5 & """; " & _
arg6 & "; " & _
arg7 & "; " & _
arg8 & "; " & _
"""" & arg9 & """)"
' Écrire la formule dans la cellule
r.Formula = formule
Else
r.Value = "Vide"
End If
End If
Next r
Else
MsgBox "Cellule 'Date de début' non trouvée"
End If
Else
MsgBox "Pas de tableau"
End If
End Sub