XL 2013 Insérer texte dans plage de cellule vide en VBA

[Eric_nov]

Bonjour le forum,
Je cherche un code VBA pour insérer un texte dans un tableau quand une ligne est vide correspondant à une cellule remplie.
Explications dans le fichier joint.
Merci.

 

[mapomme]

Bonjour @Eric_nov 😉,

Explications dans le fichier joint.

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 ?

 

[Eric_nov]

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 ?

Bonjour mapomme,

Désolé, Je vais essayer d'être plus clair.

Comment savoir si une personne est autonome ?
Dans le tableau de la feuille S21 la personne autonome que j'ai représenté par un pentagone rouge n'a aucune programmation dans le mois que je saisis dans la feuille Douche.

Par exemple: pour la personne en A9, aucune programmation dans le mois.
Ce qui veut dire qu'il est autonome et qu'il faut juste lui fournir le gel douche.

Que faire des lignes dont le nom n'est pas saisi?
Tant qu'il n'y a pas de nom, on ne les prend pas en compte.

Où inscrit-on la mention demandée?
j'aurais bien aimé qu'elle s'inscrive dans le tableau, dans la ligne correspondant à la personne autonome.
Est-ce que cela risque d'effacer la formule?

Quand fait t'on la vérification?
A partir du moment où il y a un nom dans le tableau en colonne A.

Merci.

 

[mapomme]

Re,

Un essai dans le fichier joint.

• 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.

Le code dans ThisWorkbook:

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

 

[Eric_nov]

Re,

Un essai dans le fichier joint.

• 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.

Le code dans ThisWorkbook:

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,

C'est exactement ce que je souhaitais!
Pour votre contribution, un grand MERCI 😀

 

[Eric_nov]

Bonsoir mapomme,

C'est exactement ce que je souhaitais!
Pour votre contribution, un grand MERCI 😀

Bonsoir mapomme,

En 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.
Le code peut-il être modifier où bien faut t'il mettre inoccupée si la chambre est vide et faire disparaître cette ligne?
Merci

 

[mapomme]

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.

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.
Donc la macro dès qu'elle rencontre une cellule vide en colonne A considère que la fin du tableau est atteinte.

Donnez moi un moyen de connaitre la ligne de fin d'un tableau (ligne de fin qui est différente entre S21 et S23) et je modifierai la macro en connaissance de cause. D'autant que la fin du tableau (utile) peut-être n'importe où puisque vous introduisez des lignes vides en son sein.

Il y aurait un moyen si aucune cellule utile (hors du tableau) n'existe. Ce qui n'est pas le cas car vous avez en colonne A, une formule sous chaque tableau pour indiquer le nombre de patients.

 

[Eric_nov]

Effectivement il y a plus de chambre en S21. Pour le tableau en S21 la dernière ligne est la 27.
Pour le tableau en S22 la dernière ligne est la 25.
Il arrive parfois que l'on accueille un couple. Ex: Feuille S22 la chambre 212 qui devient 212 et 212b.
Si le cas venait à se reproduire, j'agirais directement dans le code vba pour changer les valeurs.
Pouvez-vous me mettre une apostrophe avec une petite explication à l'endroit où il faudra changer les données.
Merci