XL 2010 VBA - Bordures en X par double clics et inversément

[tchi456]

Bonjour,

Dans le fichier attaché j'ai un code qui fonctionne parfaitement bien pour pouvoir mettre une croix dans n'importe quelle cellules mais je souhaiterais pouvoir le faire uniquement pour certaines cellules (D2 à D20). De plus je souhaiterais mettre une formule dans la cellule E2 pour concatener toutes les lignes ou il y a une croix dans la colonne D en gardant le même style de texte (FR normal et EN italique avec un "-" devant le texte FR) affiché en cellule E2 du fichier ci-dessous.

Le mot de passe est un point "."

Pouvez-vous m'aider?

Meilleures salutations,

Thierry

 

[sylvanu]

Bonjour Tchi,
C'est vraiment faire compliqué pour le principe, car il va falloir détecter qu'il y a une croix en dessin dans une cellule.
Vous auriez pu utiliser une lettre comme en PJ en utilisant la police Wingdings ou Wingdings2, j'ai mis deux ex en PJ.
Cela permettra ensuite très simplement de faire la concaténation en regardant le contenu de la cellule et non sa mise en forme.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ActiveSheet.Unprotect Password:="."
    On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [E1:E1000]) Is Nothing Then    ' Limitation à la colonne E
         Application.ScreenUpdating = False
         If Cells(Target.Row, "A") <> "" Then               ' Et uniquement si la colonne A comporte un N°.
            If Target = "S" Then Target = "" Else Target = "S"
            Cells(1 + Target.Row, "E").Select
        End If
    End If
Fin:
Application.ScreenUpdating = True
ActiveSheet.Protect Password:="."
End Sub

Ensuite j'ai bien peur que vous vous soyez emmêlé les pinceaux. La concaténation est à mettre en E1, non en E2 ?
Mais ça risque de vous faire un très grand texte, comme par exemple :

Couleur noir mat Couleur noir brillant (meilleur résistance à la corrosion que le Tenifer TF1-AB1)

mais qui n'auront plus de référence à la ligne. Pouvez vous être plus explicite ?

 

[tchi456]

Bonjour Sylvanu,

Merci pour votre aide. En utilisant cette police Wingdings ça me convient tout à fait.
Vous avez raison; je souhaite concatener en F2 (et pas en E2) le texte des cellules des colonnes B et C uniquement si la cellule en colonne E est cochée en gardant le même style de texte (colonne B texte normal, colonne C texte en italique et avec un "-" devant le texte). La colonne D est masquée et ne sera pas utilisée.

Meilleures salutations et bonne journée.

Thierry

 

[sylvanu]

Bonjour Tchi,
Il suffit de rajouter ce petit bout de code :

        Chaine = ""
        For i = 2 To [A65500].End(xlUp).Row
            If Cells(i, "E") = "P" Then
                Chaine = Chaine & "- " & Cells(i, "B") & Chr(10) & "- " & Cells(i, "B") & Chr(10)
            End If
        Next i
        [F2] = Chaine

Par contre je ne vois pas comment simplement mettre en italique des morceaux de phrase sans faire une usine à gaz. Donc je n'ai pas traité ce point.

 

[tchi456]

Re bonjour Sylvanu,

J'imaginais ça plutôt avec une formule mais avec du VBA c'est encore mieux.
Le soucis pour moi c'est que je suis de loin pas à votre niveau; pourriez-vous me dire ou je dois copier ce code s'il vous plait?

 

[sylvanu]

Re,
Ce code est intégré dans la macro originale, donc faites pareil.
Recopiez toute la macro dans votre feuille concernée.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ActiveSheet.Unprotect Password:="."
    On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [E1:E1000]) Is Nothing Then
         Application.ScreenUpdating = False
         If Cells(Target.Row, "A") <> "" Then
            If Target = "J" Then Target = "" Else Target = "J"
            Cells(1 + Target.Row, "E").Select
        End If
        Chaine = ""
        For i = 2 To [A65500].End(xlUp).Row
            If Cells(i, "E") = "P" Then
                Chaine = Chaine & "-" & Cells(i, "D") & Chr(10)
            End If
        Next i
        [F2] = Chaine
    End If
Fin:
Application.ScreenUpdating = True
ActiveSheet.Protect Password:="."
End Sub

 

[tchi456]

J'ai bien recopié votre code mais malheureusement il y a une erreur de compilation (variable non définie).

 

[soan]

Bonjour tchi456, sylvanu,

ton fichier en retour ; je crois avoir adapté correctement le code de sylvanu, mais vérifie quand même les colonnes et les valeurs J ou P avant d'exécuter la macro ! (je n'ai pas testé)​

Option Explicit

'Pour cocher les cellules D2 à D1000

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  ActiveSheet.Unprotect Password:="."
  On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
  Dim Chaine$, i&
  If Not Intersect(Target, [D1:D1000]) Is Nothing Then
    Application.ScreenUpdating = False
    If Cells(Target.Row, "B") <> "" Then
      If Target = "J" Then Target = "" Else Target = "J"
      Cells(1 + Target.Row, "D").Select
    End If
    Chaine = ""
    For i = 2 To [B65500].End(xlUp).Row
      If Cells(i, "D") = "P" Then
        Chaine = Chaine & "-" & Cells(i, "C") & Chr$(10)
      End If
    Next i
    [F2] = Chaine
  End If
Fin:
  Application.ScreenUpdating = True
  ActiveSheet.Protect Password:="."
End Sub

soan

 

[sylvanu]

Bonjour tout le monde,
Je viens de m'apercevoir que ce post est prêt depuis ce matin .... mais pas émis.
Il disait :
"Je ne vois pas où vous avez intégré la nouvelle macro.
En PJ ça marche."

 

[tchi456]

Bonjour tout le monde,
Je viens de m'apercevoir que ce post est prêt depuis ce matin .... mais pas émis.
Il disait :
"Je ne vois pas où vous avez intégré la nouvelle macro.
En PJ ça marche."

Re bonjour Sylvanu,

Mais ça fonctionne merveilleusement bien.
Merci beaucoup pour votre aide si précieuse; vous êtes vraiment doué.

Mes respectueuses salutations et bonne fin de journée !