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

tchi456

XLDnaute Occasionnel
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
 

Pièces jointes

  • Traitements.xlsm
    25.5 KB · Affichages: 3
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
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.
VB:
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 ?
 

Pièces jointes

  • Traitements.xlsm
    29.5 KB · Affichages: 2

tchi456

XLDnaute Occasionnel
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
 

Pièces jointes

  • Traitements 2.xlsm
    32.1 KB · Affichages: 1

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Tchi,
Il suffit de rajouter ce petit bout de code :
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.
 

Pièces jointes

  • Traitements 2.xlsm
    29.9 KB · Affichages: 1
Dernière édition:

tchi456

XLDnaute Occasionnel
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

XLDnaute Barbatruc
Supporter XLD
Re,
Ce code est intégré dans la macro originale, donc faites pareil.
Recopiez toute la macro dans votre feuille concernée.
VB:
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
 

soan

XLDnaute Barbatruc
Inactif
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é)

VB:
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
 

Pièces jointes

  • Test.xlsm
    26.7 KB · Affichages: 0

tchi456

XLDnaute Occasionnel
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 !
 

Discussions similaires

Réponses
4
Affichages
740