Pour faire suite à ce fil : colorer des lignes sous conditions
Un premier jet qui peut encore être amélioré en fonction des contraintes que l'utilisateur final est susceptible de devoir affronter. Je me suis autoriser quelques libertés qui n'apparaissaient pas dans le cahier des charges, réversibles si besoin :
-) J'ai mis une liste déroulante dans les colonnes J,M,P afin de sélectionner A ou P pour absent ou présent, cela limite les erreurs de saisie.
-) Lorsqu'une des colonnes J,M,P contient la lettre P, la ligne est volontairement verrouillée. Pour effectuer une éventuelle correction sur une ligne, il faut sélectionner "Corriger" dans la colonne R et modifier ce qui doit l'être sur cette ligne. Elle sera à nouveau protégée lorsqu'un P aura été saisi.Pour communiquer entre la feuille1 et la feuille2, j'ai besoin d'un identifiant unique pour retrouver les lignes écartée lors de la première absence. Je me suis basé sur la colonne A en espérant que chaque ligne possède un numéro différent.
Le fichier est conçu pour fonctionner ligne par ligne. Si il devait être alimenté par copier coller d'un autre fichier, il faudrait copier/coller les données de la colonne A à I (pas plus). La colonne J devra être remplie manuellement ligne par ligne pour que le système fonctionne correctement.
Je te laisse tester, n’hésite pas à te plaindre si ça ne fonctionne pas correctement et n'hésite pas non plus à persévérer pour comprendre comment il fonctionne.
Code : Tout sélectionner
Option Explicit
Sub Main(oEvt)
if oEvt.supportsService("com.sun.star.table.Cell") then
Dim oDoc As Object, oCa As Object
Dim nSheet As Long, nCol As Long, nRow As Long
oDoc = Thiscomponent : oCa = oEvt.CellAddress
nSheet = oCa.Sheet : nCol = oCa.Column : nRow = oCa.Row
Select Case nCol
Case 9, 12, 15, 17
Select Case oEvt.String
Case "A"
If nCol = 15 Then
oDoc.Sheets(nSheet).GetCellRangeByPosition(0,nRow,16,nRow).CellStyle = "AA"
oDoc.Sheets(nSheet).GetCellByPosition(16,nRow).SetString("RENONCE")
End If
If nCol = 12 Then
oDoc.Sheets(nSheet).GetCellRangeByPosition(0,nRow,nCol,nRow).CellStyle = "A"
oDoc.Sheets(nSheet).GetCellRangeByPosition(nCol+1,nRow,16,nRow).CellStyle = "STD"
End If
If nCol = 9 Then
Dim y As Long, ref As Long, Formule1 As String, Formule2 As String
ref = oDoc.Sheets(nSheet).GetCellByPosition(0,nRow).Value
y = EmptyFirstLine(nSheet+1)
oDoc.Sheets(nSheet).GetCellRangeByPosition(0,nRow,nCol,nRow).CellStyle = "A"
oDoc.Sheets(nSheet).GetCellRangeByPosition(nCol+1,nRow,16,nRow).CellStyle = "STD"
oDoc.Sheets(nSheet+1).GetCellRangeByPosition(0,y,9,y).SetDataArray(oDoc.Sheets(nSheet).GetCellRangeByPosition(0,nRow,9,nRow).DataArray)
oDoc.Sheets(nSheet+1).GetCellRangeByPosition(0,y,9,y).CellStyle = "A"
Formule1 ="=IF(ISERROR(VLOOKUP($A"&Cstr(nRow+1)&";$Feuille2.$A$1:$L$1000;COLUMN();0));""""&T(STYLE(""STD""));TEXT(VLOOKUP($A"&Cstr(nRow+1)&";$Feuille2.$A$1:$L$1000;COLUMN();0);""JJ/MM/AA""))&T(STYLE(""A""))"
Formule2 ="=IF(ISERROR(VLOOKUP($A"&Cstr(nRow+1)&";$Feuille2.$A$1:$L$1000;COLUMN();0));""""&T(STYLE(""STD""));TEXT(VLOOKUP($A"&Cstr(nRow+1)&";$Feuille2.$A$1:$L$1000;COLUMN();0);""HH:MM:SS""))&T(STYLE(""A""))"
oDoc.Sheets(nSheet).GetCellByPosition(nCol+1,nRow).SetFormula(Formule1)
oDoc.Sheets(nSheet).GetCellByPosition(nCol+2,nRow).SetFormula(Formule2)
End If
Case "P"
oDoc.Sheets(nSheet).GetCellRangeByPosition(0,nRow,nCol,nRow).CellStyle = "P"
oDoc.Sheets(nSheet).GetCellRangeByPosition(nCol+1,nRow,16,nRow).CellStyle = "GR"
oDoc.Sheets(nSheet).GetCellByPosition(16,nRow).SetString("")
Case "Modifier"
oDoc.Sheets(nSheet).GetCellRangeByPosition(0,nRow,16,nRow).CellStyle = "STD"
oDoc.Sheets(nSheet).GetCellByPosition(17,nRow).SetString("")
End Select
End select
End if
End Sub
Function EmptyFirstLine(index As Long) As Long
EmptyFirstLine = Thiscomponent.Sheets(index).Columns.GetByName("A").queryEmptyCells.RangeAddresses(0).StartRow
End Function
et le fichier pour tester :