Worksheet_Change Intersect et combinaison de recherches dans 5 colonnes

J'avoue pour cette partie, je n'avais pas pensé à utiliser l'enregistreur de Macros pour m'inspirer.

Merci encore.

Je regarde tout à lheure pour régler les valeurs puis intégrer ca au code général.

Merci

Re,

N'hésite pas si tu as besoin.

Bonne fin de soirée et bonne poursuite dans tes études.

Amicalement

Je m'y remets dans un petite heure. Je te dirais si ça avance comme je souhaite.

Merci

Bonne soirée à toi aussi, l'ami

Série de test

Je viens de faire une série de test.

Tout semble fonctionner à l'exception du rectangle avec des flèches en ligne 15. Il semblerait que le script ne prenne pas en compte l'instruction qd la colonne 1 comporte une chaine de lettres (et non des chiffres comme pour les autres cas).

Centrer les triangles dans une cellule et figer sa taille et hauteur

Pour la taille des triangles, après plusieurs essais, j'ai fait deux choix (voir code ci dessous). Néanmoins, j'ai beau essayé plusieurs solutions, dès que je bouge la taille d'une colonne, le triangle bouge avec.J'ai essayé de trouver une instruction pour figer le triangle créé au centre de la cellule visée mais à priori c'est moins évident qu'escompté lol

Enregistreur de macros

J'ai suivi ton conseil sur l'utilisation de l'enregistreur de macros pour poursuivre ma quête : Relier deux triangles créés si le nom du shape est inséré dans une nouvelle colonne.. Un échec cuisant mais cela m'a permis de découvrir de nouvelles formules.

J'ai également découvert que la nomination de mes shapes pourrait être optimisée (exemple "SHP_" + numéro de lignes + numéro de colonnes ; mais je ne sais pas si ca va pas tout faire buguer. J'essaierai demain à tête reposée)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ShpNum As String, Tache As Variant, i As Integer
Dim Couleur As Long, Rouge As Integer, Vert As Integer, Bleu As Integer
Dim Derl%
Derl = Range("AN" & Rows.Count).End(xlUp).Row
'Check if C or D date columns and ignore if not
If Not Intersect(Target, Range("AO16:AS" & Derl, "AO12:AP13")) Is Nothing Then 'Edit 12 & or 540 if inappropriate"
'Check if more than one cell and ignore if yes
If Target.Count > 1 Then Exit Sub

'Otherwise...
r = Target.Row
' ignore if an empty Column A in row
If Cells(r, 1) = "" Then Exit Sub

'otherwise a date has been changed

shpname = "SHP_" & Cells(r, 1) 'Shape Name
'Delete current shape of that name if it exists
On Error Resume Next
For i = 1 To 5: ActiveSheet.Shapes.Range(Array(shpname)).Delete: Next i
On Error GoTo 0
' do stuff based on data in column 'AN' à 'AS'
Tache = Array(41, 42, 43, 44, 45)

For i = 0 To 4
   If Cells(r, Tache(i)) <> "" Then

       'get single date  cells
       LftCell = Cells(r, 41) - Cells(10, 3) + 47
       rtCell = Cells(r, Tache(i)) - Cells(10, 3) + 47
       Couleur = Cells(r, Tache(i)).Font.Color

      Rouge = Int(Couleur Mod 256)
      Vert = Int((Couleur Mod 65536) / 256)
      Bleu = Int(Couleur / 65536)
      Select Case Cells(r, 40).Value

      Case "Lancement du projet"
          'Triangle for start date
          Set Newshp = ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, Cells(r, rtCell).Left, Cells(r, rtCell).Top + 2, Cells(r, rtCell).Width, Cells(r, rtCell).Height - 4)
              Newshp.Width = 10
              Newshp.Fill.ForeColor.RGB = RGB(Rouge, Vert, Bleu)
              Newshp.Line.ForeColor.RGB = RGB(Rouge, Vert, Bleu)

      Case "Pose voie"
          'Triangle for start date
          Set Newshp = ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, Cells(r, rtCell).Left, Cells(r, rtCell).Top + 2, Cells(r, rtCell).Width, Cells(r, rtCell).Height - 4)
              Newshp.Left = Cells(r, rtCell).Left + (Cells(r, rtCell).Width / 6) - (Newshp.Width / 6)
              Newshp.Top = Cells(r, rtCell).Top + (Cells(r, rtCell).Height / 6) - (Newshp.Height / 6)
              Newshp.Fill.ForeColor.RGB = RGB(Rouge, Vert, Bleu)
              Newshp.Line.ForeColor.RGB = RGB(Rouge, Vert, Bleu)

      Case "Chaussée provisoire", Cells(r, Tache(i)).Value = ""
          'Triangle for start date
          Set Newshp = ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, Cells(r, rtCell).Left, Cells(r, rtCell).Top + 2, Cells(r, rtCell).Width, Cells(r, rtCell).Height - 4)

              Newshp.Width = Newshp.Width / ((Newshp.Height) / (Cells(r, rtCell).Height - 6))
              Newshp.Left = Cells(r, rtCell).Left + (Cells(r, rtCell).Width / 4) - (Newshp.Width / 8)
              Newshp.Top = Cells(r, rtCell).Top + (Cells(r, rtCell).Height / 4) - (Newshp.Height / 8)

              Newshp.Fill.ForeColor.RGB = RGB(Rouge, Vert, Bleu)
              Newshp.Line.ForeColor.RGB = RGB(Rouge, Vert, Bleu)

      Case "Mise à hauteur"
          'Triangle for start date
          Set Newshp = ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, Cells(r, rtCell).Left, Cells(r, rtCell).Top + 2, Cells(r, rtCell).Width, Cells(r, rtCell).Height - 4)
              Newshp.Width = 10
              Newshp.Fill.ForeColor.RGB = RGB(Rouge, Vert, Bleu)
              Newshp.Line.ForeColor.RGB = RGB(Rouge, Vert, Bleu)

      Case "NC"
          'Triangle for start date
          Set Newshp = ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, Cells(r, rtCell).Left, Cells(r, rtCell).Top + 2, Cells(r, rtCell).Width, Cells(r, rtCell).Height - 4)
              Newshp.Width = 10
              Newshp.Fill.ForeColor.RGB = RGB(Rouge, Vert, Bleu)
              Newshp.Line.ForeColor.RGB = RGB(Rouge, Vert, Bleu)

      Case "Artère câble"
          'Triangle for start date
          Set Newshp = ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, Cells(r, rtCell).Left, Cells(r, rtCell).Top + 2, Cells(r, rtCell).Width, Cells(r, rtCell).Height - 4)
              Newshp.Width = 10
              Newshp.Fill.ForeColor.RGB = RGB(Rouge, Vert, Bleu)
              Newshp.Line.ForeColor.RGB = RGB(Rouge, Vert, Bleu)

      Case "Fin du projet"
          'Triangle for end date
          Set Newshp = ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, Cells(r, rtCell).Left, Cells(r, rtCell).Top + 2, Cells(r, rtCell).Width, Cells(r, rtCell).Height - 4)
              Newshp.Width = 10
              Newshp.Fill.ForeColor.RGB = RGB(Rouge, Vert, Bleu)
              Newshp.Line.ForeColor.RGB = RGB(Rouge, Vert, Bleu)

      Case Else
      'Quit if only one date and b is not Project Start or Project Finish text
          On Error GoTo OnlyONEDate:
          'Get date ranges
          Set DtRng = Range(Cells(r, LftCell), Cells(r, rtCell))
          LftCell = Cells(r, 41) - Cells(10, 3) + 47
          rtCell = Cells(r, 42) - Cells(10, 3) + 47

          ' if number in A then add a rectangle
          If IsNumeric(Cells(r, 1)) Then
              Set Newshp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, DtRng.Left, DtRng.Top + 5, DtRng.Width, DtRng.Height - 10)
             Else

            'Otherwise if text in A add arrow  bar
             Set Newshp = ActiveSheet.Shapes.AddShape(msoShapeLeftRightArrow, DtRng.Left, DtRng.Top + 3, DtRng.Width, DtRng.Height - 6)
              Newshp.Width = 10
              Newshp.Fill.ForeColor.RGB = RGB(146, 208, 80)
              Newshp.Line.ForeColor.RGB = RGB(146, 208, 80)
          End If
      End Select

   'Name shape as per value of A for unique reference
      Newshp.Name = shpname
   End If
Next i
End If
'Point of exit if only one of two dates entered.
Exit Sub
OnlyONEDate:
On Error GoTo 0
End Sub

En tout cas, ce qui est certain, c'est qu'aujourd'hui, grâce à toi, j'ai considérablement avancé et je n'ai pas vu le temps passé (malgré le soleil). J'enregistre tout et je vais me coucher. Bonne soirée/nuit et merci encore l'ami

Bonjour TontonK,

Quand je disais hier qu'on pouvait modifier les propriétés du shape en te donnant l'exemple de la largeur, je pensais que d'une tâche à l'autre tu voulais apporter des particularités.

Au vu de ton code, ça n'est pas le cas.

Je crois qu'on peut simplifier pas mal ta procédure mais j'aurais besoin de savoir ce qu'il y a dans ton projet en colonne 3 car tu y fais référence dans le calcul de la position du shape. LftCell = Cells(r, 41) - Cells(10, 3) + 47

D'ailleurs la variable LftCell n'est pas utilisée. On peut utiliser l'une ou l'autre RtCell car dans ce que je vois elles font la même chose.

Une autre question. Comment peut-on différentier Opération AT x des autres comme Pose voie, etc?

Est-ce que je peux utiliser le mot Opération ou puis je créer une colonne intermédiaire pour les différentier?

Je commence le ménage et j'attends ta réponse pour les particularités.

Cdt

Bonjour,

Quand je disais hier qu'on pouvait modifier les propriétés du shape en te donnant l'exemple de la largeur, je pensais que d'une tâche à l'autre tu voulais apporter des particularités.

Non, l'idée n'est pas d'avoir des particularités sur le format des triangles. Ce que j'aimerai, c'est quand je crée un triangle, que sa taille soit unique et qu'il soit centré dans sa cellule. Normalement les cellules ne devraient pas trop avoir à bouger, mais comme c'est un grand planning, il est possible d'avoir des triangles qui se chevauchent. J'ai voulu différencier au cas où plus tard j'ai envie de décaler légèrement la positionnement des triangles par rapport au centre de la cellule (pour le cas où deux triangles soient créés pour le même jour ; rare mais pas impossible donc je me suis laissé la possibilité pour plus tard)

Autre questionnement que l'on pourra revoir plus tard : Dans mes tests hier, j'ai remarqué qu'en changeant tous les chiffres par des dates, ça ne fonctionnait plus, alors que dans les prémisses de mon code, j'arrivais à faire soit des nombres soit des dates. Comment as-tu fait pour conditionner cela stp?

Je crois qu'on peut simplifier pas mal ta procédure mais j'aurais besoin de savoir ce qu'il y a dans ton projet en colonne 3 car tu y fais référence dans le calcul de la position du shape. LftCell = Cells(r, 41) - Cells(10, 3) + 47

C'est juste qu'initialement j'avais commencé par les colonnes 1 à 4 pour me simplifier les choses et quand ça a marché, j'ai décallé pour se caler dans mon planning. La Cellule 3 revoit à des lieux géographiques (je répète le lieu autant de fois qu'il y a d'opérations dans ce secteur.

D'ailleurs la variable LftCell n'est pas utilisée. On peut utiliser l'une ou l'autre RtCell car dans ce que je vois elles font la même chose.

Initialement, je bossais entre deux cellules, donc pour le lancement de projet j'utilisais "LftCell" et pour la fin de projet "RtCell". Ensuite j'ai ajouté les opérations spécifiques, et c'est vrai que maintenant, ça n'a plus trop de sens...

Une autre question. Comment peut-on différentier Opération AT x des autres comme Pose voie, etc?

Est-ce que je peux utiliser le mot Opération ou puis je créer une colonne intermédiaire pour les différentier?

Pour les 5 tâches spécifiques, je souhaite l'apparition d'un triangle. Pour les autres tâches, je vais gérer ça simplement avec la mise en forme conditionnelle. Ces 5 tâches spécifiques apparaissent dans un autre onglet ('Paramètres' en colonne 'AQ').

Pour les autres activités, il y a beaucoup de noms et je ne gère pas les dénominations, donc je ne peux pas créer de préfixes ou suffixes pour différencier les opérations spécifiques des opérations "classiques". J'ai mis le terme "opération" pour l'exemple, mais cette dénomination n'existera pas dans le support final.

Je commence le ménage et j'attends ta réponse pour les particularités.

Désole pour le roman, mais j'essaie d'être le plus précis dans mes réponses,

Pas de soucis. je suis sur le PC toute la journée. Prends ton temps l'ami

J'ai pris bonne note de tes commentaires.

Une autre question.

L'Enginerring représente la durée globale. Il faut donc que la flèche fasse la longueur début à fin du chantier ?

Si oui, comme les cellules sur cette ligne sont des cellules calculées il va falloir faire autrement.

Toujours si oui, est- ce que je peux utiliser quelques colonnes à gauche ou à droite pour des calculs qui seront la référence pour la longueur de la flèche? Ces colonnes seront masquées par la suite.

Merci pour ta réponse

Cdt

J'ai pris bonne note de tes commentaires.

Une autre question.

L'Enginerring représente la durée globale. Il faut donc que la flèche fasse la longueur début à fin du chantier ?

En fait, il y a plusieurs lignes synthétiques à l'image de la ligne Enginerring. Pour les cases de début et de fin, j'ai utilisé une formule excel Min et Max sur la plage considérée. Du coup les dates sur la ligne engineering prennent la période de temps de la phase considérée.

Si oui, comme les cellules sur cette ligne sont des cellules calculées il va falloir faire autrement.

Toujours si oui, est- ce que je peux utiliser quelques colonnes à gauche ou à droite pour des calculs qui seront la référence pour la longueur de la flèche? Ces colonnes seront masquées par la suite.

Si l'explication plus haut ne convient pas, oui, c'est tout à fait possible. Idéalement à droite si possible, mais sinon, fais à ton aise

En espérant t'avoir apporté les éléments dont tu as besoin.

Cdlt

Re,

Je pensais raccourcir le code mais en fait il n'en est rien Pour ce que tu souhaites obtenir, on aurait de toute façon été contraint de le modifier.

On verra par la suite pour faire des sous procédures éventuellement.

Regarde la nouvelle version et commente là.

Je te laisse un moment.

Courage!

2v3-totonk.xlsm (32.34 Ko)

Il y avait un end if de mal positionné.

Ca t'éviteras des commentaires inutiles

Cdt

2v3-totonk.xlsm (32.49 Ko)

La nouvelle version est top :

pour les lignes type Engineering, cela fonctionne parfaitement

Pour les lignes spécifiques, tout a l'air de fonctionnement parfaitement

Pour les colonnes, j'ai noté quelques éléments :

  • -> si je ne mets pas la valeur en 'AP' en premier, les triangles correspondant aux valeurs des colonnes de 'AQ' à 'AT'.
  • -> si je mets la valeur en 'AT' avant de mettre la valeur en 'AS', la création du triangle pose problème : Je mets une valeur en AS, pas de souci, mais si je reviens en 'AT' pour changer la valeur ou la supprimer, aucune réaction. pour résoudre cela, je dois à nouveau changer ou supprimer la valeur en 'AS' pour que le triangle soit supprimé ou déplacé.

Pour les opérations classiques, en changeant les valeurs, mes rectangles ne bougent pas. Je vais éteindre et relancer mon PC pour voir si ce n'est pas mon logiciel EXCEL et ou mon PC qui fait des siennes.

J'ai un rendez-vous professionnel. Je reviens dans moins d'une heure.

Bon ap' si tu passes à table entre temps

Cdlt.

Ah mince, je venais de te faire un joli roman.. lol

je regarde ça dans 30 min après mon rdv

a tout

Commentaire

Effectivement, ça règle un peu le problème mais j'ai encore deux éléments à reprendre :

--> Pour 'Lancement de projet' & 'Fin de projet' : aucune action en modifiant les dates

--> pour la colonne 'AT'

- Pour création un nouveau triangle ou modifier sa position, c'est tjs soumis à une action sur une autre colonne. et si tu modifies ou sur la valeur en AT en dernier, le triangle reste comme il était, jusqu'à tu ajoutes une nouvelle valeur sur une des colonnes entre 'AP' et 'AS'.

Retour global

Sinon, je viens de parcourir ton code, tu as entamé une vraie refonte et ça me paraît 10 fois plus clair. MERCI.

pour la colonne 'AT'

- Pour création un nouveau triangle ou modifier sa position, c'est tjs soumis à une action sur une autre colonne. et si tu modifies ou sur la valeur en AT en dernier, le triangle reste comme il était, jusqu'à tu ajoutes une nouvelle valeur sur une des colonnes entre 'AP' et 'AS'

Le problème était dû au fait que j'ai ajouté une colonne. C'est réglé!

Deux questions :

Pour les dates tu parles des dates de début et de fin de projet? Initialement, tu avais des triangles, c'est ce que tu veux?

Tu veux que le planning soit recalé par rapport à la date de début?

J'attends tes réponses pour faire la modif.

img1

Pour les dates tu parles des dates de début et de fin de projet? Initialement, tu avais des triangles, c'est ce que tu veux?

Si les triangles apparaissent comme sur ton image, c'est bon pour moi.

Par contre, est ce possible de rendre impossible la saisie dans les cases ''AP12 & 'AQ13' comme ça ça force l'utilisateur à ne saisir qu'un début de projet et qu'une fin de projet. Sinon je pensais mettre les cases en noir.

Idem pour les projets "classiques" : est possible sur ces lignes là, de mettre les cases des colonnes ''AR'', ''AS & 'AT' avec un fond noir pour éviter une saisie dans ces cases (En effet pour ces lignes, on veut une date de début et une date de fin.. les autres cases sont unitules.

Tu veux que le planning soit recalé par rapport à la date de début?

Non pas besoin de recaler le planning en fonction de ses dates (même si j'avoue, cette idée pourrait être top pour d'autres projets

En espérant avoir répondu à tes questions...

Re,

Voici une version un peu plus structurée.

J'ai commenté une partie de la procédure pour t'en faciliter la compréhension.

Tiens moi au courant

1v3-1-totonk.xlsm (35.91 Ko)

Lecture du code

J'ai pris le temps de tout relire le code. C'est là que l'on comprend et assimile que VBA c'est une vraie compétence et que ça prendra du temps pour atteindre un niveau de maîtrise acceptable. Si dans ta boite il recrute en septembre un ingénieur, je veux bien devenir ton bras droit et continuer à apprendre (l'espoir fait vivre, hein ? lol)

Test du fichier

J'ai également testé et dupliquer les lignes pour essayer toutes les conditions possibles (du moins, celles auxquelles je pense aujourd'hui).

J'ai noté deux bugs subsistants :

Flèches vertes

---> dans la ligne engineering, les cellules sont fusionnées, donc on peut pas sélectionner "F", du coup, si tu changes les valeurs min ou max du tableau, ça n'affecte pas l'objet flèche verte.

Par contre, dans les autres lignes, si tu choisit "F" en colonne "AN", tout roule

Rectangle bleu

--> quand tu supprimes les valeurs numériques pour une activité "R", après suppression, un rectangle de longueur d'une cellule vient se positionner en colonne "AX". Ce petit rectangle apparaît peu importe l'ordre dans lequel tu supprimes les valeurs numériques. Et lorsque tu saisis de nouvelles valeurs numériques, il reste présent.

Sub EffaceShape()

For Each s In ActiveSheet.Shapes

On Error Resume Next

If Not Intersect(s.TopLeftCell, Range(Cells(r, "AY"), Cells(r, "CY"))) Is Nothing Then

s.Delete

End If

On Error GoTo 0

Next s

End Sub

Je vois que tu utilises plusieurs fois ce bout de code, mais je ne suis pas sûr de comprendre.

Tu vérifies que tu n'as pas de shapes sur la ligne entre les colonnes AY et CY et si tu en trouves, tu les supprimes tous avant de les recréer sur cette ligne ?

Si oui, pour corriger le souci avec les rectangles bleus, est ce cohérent que j'imagine étendre cette fonction EffaceShape de AX à CY pour résoudre la question de la suppression de ces petits rectangles ?

Merci pour ton travail et tes annotations. Et c'est vraiment top de voir comment le programme évolue et que tu fasses en sorte que je comprenne la logique.


Proverbe : Confucius. Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson.

Re,

Flèches vertes

---> dans la ligne engineering, les cellules sont fusionnées, donc on peut pas sélectionner "F", du coup, si tu changes les valeurs min ou max du tableau, ça n'affecte pas l'objet flèche verte.

Dans cette ligne, normalement on intervient pas puisqu'il y a des formules. Si tu te fiche des formules et que tu veilles entrer des valeurs, je fais la modif.

En revanche, je pensais que cette flèche devait s'ajuster automatiquement lorsque l'on changeait des "T" Triangles. C'est la raison pour laquelle elle ne bouge pas si tu modifies une valeur sur cette ligne 15

Rectangle bleu

--> quand tu supprimes les valeurs numériques pour une activité "R", après suppression, un rectangle de longueur d'une cellule vient se positionner en colonne "AX". Ce petit rectangle apparaît peu importe l'ordre dans lequel tu supprimes les valeurs numériques. Et lorsque tu saisis de nouvelles valeurs numériques, il reste présent.

Tu as la aussi des formules colonne AP+3.

Tu entreras donc des valeurs dans ces cellules.

Tu as tout compris pour la suppression des shapes. On remplace AY par AX et dès qu'on replacera une valeur dans les cellules, il disparaitra. Ca n'est pas grave car ces colonnes seront masquées à terme.

Maintenant, il va falloir penser à savoir qu'elles sont les cellules à verrouiller ou déverrouiller pour éviter les erreurs de d'effacement intempestifs. Réfléchir aussi qu'elles seront les colonnes masquées sur la gauche du planning. (toutes ou pas)?

Tu me dis pour la flèche verte..

Pour la flèche, j'ai fait la modification.

Regarde et dis moi.

Tu m'avais parlé aussi de voir si on ne pouvait pas faire quelques chose en cas de même valeurs, les triangles allaient se confondre.

Vois ce que j'ai fait si cela convient.

Cdt

9v3-2-totonk.xlsm (41.74 Ko)

Dans cette ligne, normalement on intervient pas puisqu'il y a des formules. Si tu te fiche des formules et que tu veilles entrer des valeurs, je fais la modif.

En revanche, je pensais que cette flèche devait s'ajuster automatiquement lorsque l'on changeait des "T" Triangles. C'est la raison pour laquelle elle ne bouge pas si tu modifies une valeur sur cette ligne 15

Je suis d'accord avec toi, inutile de faire une modification sur la ligne. Toutefois, si le changement automatique pouvait s'opérer lorsque l'on changeait des "T" Triangles et pour les "R" Triangles, ce serait parfait. Comme ça, la flèche verte considère toute la plage où l'utilisateur fera une saisie (à priori, c'est moi, mais c'est possible que mes conducteurs de travaux travaillent également dessus).

Tu as la aussi des formules colonne AP+3.

Tu entreras donc des valeurs dans ces cellules.

Ok

Tu as tout compris pour la suppression des shapes. On remplace AY par AX et dès qu'on replacera une valeur dans les cellules, il disparaitra. Ca n'est pas grave car ces colonnes seront masquées à terme.

Parfait.

Maintenant, il va falloir penser à savoir qu'elles sont les cellules à verrouiller ou déverrouiller pour éviter les erreurs de d'effacement intempestifs. Réfléchir aussi qu'elles seront les colonnes masquées sur la gauche du planning. (toutes ou pas)?

Alors à gauche, si j'ai volontairement laisser de la place, c'est parce que j'utilise les lignes et colonnes pour d'autres éléments..

Et pour le verrouillage des cellules, si tu veux, je peux te mettre les cellules à verrouiller avec un fond noir pour te présenter mon besoin.

Cdlt

Rechercher des sujets similaires à "worksheet change intersect combinaison recherches colonnes"