Explications dans le fichier joint.
Bonjour mapomme,Bonjour @Eric_nov ,
Que les explications sont indigentes pour les potentiels répondeurs qui ne connaissent rien à votre projet!
- quand doit-on faire la vérification ?
- comment savoir si une personne est autonome ou non ?
- que faire des lignes dont le nom n'est pas saisi ?
- où inscrit-on la mention demandée ?
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim nomSh As String, parmiFeuilles As String
Dim xsh As Shape, nbj&, i&, j&, t, s$
nomSh = "," & LCase(Sh.Name) & ","
parmiFeuilles = "," & LCase(NomDesFeuilles) & ","
If InStr(parmiFeuilles, nomSh) = 0 Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next
For Each xsh In Sh.Shapes
If xsh.Name Like "gel_*" Then xsh.Delete
Next xsh
On Error GoTo 0
nbj = Day(DateSerial(Year([b6]), Month([b6]) + 1, 0))
For i = 7 To Rows.Count
t = Cells(i, 1).Resize(1, nbj + 1)
If Trim(t(1, 1)) = "" Then Exit For
If Trim(t(1, 1)) <> "M." And Trim(t(1, 1)) <> "Mme" Then
s = ""
For j = 2 To UBound(t, 2): s = s & Trim(t(1, j)): Next
If InStr(s, "D") = 0 Then
Set xsh = Sh.Shapes.AddShape(msoShapeRoundedRectangle, 288.6, 22.8, 182.4, 40.8)
With xsh
.Name = "gel_" & i
.TextFrame2.TextRange.Characters.Text = "fournir gel douche et shampoing"
.TextFrame2.VerticalAnchor = msoAnchorMiddle
.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(192, 0, 0)
.Fill.ForeColor.RGB = RGB(255, 242, 204)
.Left = Cells(i, "m").Left + 1
.Top = Cells(i, "m").Top + 1
.Height = Cells(i, "m").Height - 2
.Width = 10 * Cells(i, "m").Width
.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter
.TextFrame2.TextRange.Font.Size = 10
.Line.Visible = msoFalse
End With
End If
End If
Next i
End Sub
Bonsoir mapomme,Re,
Un essai dans le fichier joint.
Le code dans ThisWorkbook:
- On utilise des formes car tout texte saisi dans une cellule en efface la formule.
- Les feuilles S21 et S22 se mettent à jour quand elles sont activées.
- Tout le code se trouve dans le module de code de ThisWorkbook.
- Une constante dans ce module nommée NomDesFeuilles contient la liste des feuilles concernées séparés par des virgules.
VB:Private Sub Workbook_SheetActivate(ByVal Sh As Object) Dim nomSh As String, parmiFeuilles As String Dim xsh As Shape, nbj&, i&, j&, t, s$ nomSh = "," & LCase(Sh.Name) & "," parmiFeuilles = "," & LCase(NomDesFeuilles) & "," If InStr(parmiFeuilles, nomSh) = 0 Then Exit Sub Application.ScreenUpdating = False On Error Resume Next For Each xsh In Sh.Shapes If xsh.Name Like "gel_*" Then xsh.Delete Next xsh On Error GoTo 0 nbj = Day(DateSerial(Year([b6]), Month([b6]) + 1, 0)) For i = 7 To Rows.Count t = Cells(i, 1).Resize(1, nbj + 1) If Trim(t(1, 1)) = "" Then Exit For If Trim(t(1, 1)) <> "M." And Trim(t(1, 1)) <> "Mme" Then s = "" For j = 2 To UBound(t, 2): s = s & Trim(t(1, j)): Next If InStr(s, "D") = 0 Then Set xsh = Sh.Shapes.AddShape(msoShapeRoundedRectangle, 288.6, 22.8, 182.4, 40.8) With xsh .Name = "gel_" & i .TextFrame2.TextRange.Characters.Text = "fournir gel douche et shampoing" .TextFrame2.VerticalAnchor = msoAnchorMiddle .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(192, 0, 0) .Fill.ForeColor.RGB = RGB(255, 242, 204) .Left = Cells(i, "m").Left + 1 .Top = Cells(i, "m").Top + 1 .Height = Cells(i, "m").Height - 2 .Width = 10 * Cells(i, "m").Width .TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter .TextFrame2.TextRange.Font.Size = 10 .Line.Visible = msoFalse End With End If End If Next i End Sub
Bonsoir mapomme,Bonsoir mapomme,
C'est exactement ce que je souhaitais!
Pour votre contribution, un grand MERCI
C'est tout à fait normal. Sur votre premier exemple, les lignes utiles du tableau comprenaient en colonne A soit "M." soit "Mme". On part donc de la ligne 7 et on descend de ligne en ligne jusqu'à rencontrer une cellule vide en colonne A qui représente la fin du tableau.n remplissant cette après-midi le tableau de la feuille Douche pour le service S21/S22 , je me suis rendu compte que si il y avait une ligne où il n'y avait pas de nom dans une chambre inoccupée, la procédure "fournir gel-douche et....) s'arrêtait et ne reprenait pas pour le reste du tableau.