Alt enter - Chr(10) Insérer des lignes vides dans 1 cellule

Bonjour,

Dans le fichier joint qui me sert de cobaye, des commentaires sont insérés en D14 - D107, avec un retour à la ligne, et un ajustement des cellules automatiques.

Dans le worksheet change, la police est standardisée dès que l'on inscrit des commentaires ou lors de copier-coller.

Automatiquement, peut-on simuler en vba, la commande ALT + ENTER, ou utiliser chr(10), pour forcer l'insertion d'une ligne, dans chaque cellule de la colonne D, avant et après les commentaires?

Merci pour votre aide.

bonjour,

une proposition de modification

Private Sub Worksheet_Change(ByVal Target As Range)
    Set Target = Intersect(Target, Range("C14:C107"), Me.UsedRange)
    Dim Cel As Range
    For Each Cel In Target
        If Cel <> "" Or Cells(Cel.Row, "B") <> "" Then
        Application.EnableEvents = False
        Cells(Cel.Row, "B") = Now
        If Left(Cel.Value, 1) <> Chr(10) Then Cel.Value = Chr(10) & Cel.Value & Chr(10)
        Application.EnableEvents = False
        End If
    Next
    With Range("D14:D107")
        With .Font
            .Name = "Times New Roman"
            .Size = 12
        End With
    End With
End Sub

Bonjour,

Merci pour cette proposition.

Le code s'arrête à : For Each Cel In Target et se met en mode débogage.

re-bonjour,

j'ai dû oublier un test

Private Sub Worksheet_Change(ByVal Target As Range)
    Set Target = Intersect(Target, Range("C14:C107"), Me.UsedRange)
    If Not Target Is Nothing Then
        Dim Cel As Range
        For Each Cel In Target
            If Cel <> "" Or Cells(Cel.Row, "B") <> "" Then
                Application.EnableEvents = False
                Cells(Cel.Row, "B") = Now
                If Left(Cel.Value, 1) <> Chr(10) Then Cel.Value = Chr(10) & Cel.Value & Chr(10)
                Application.EnableEvents = False
            End If
        Next
        With Range("D14:D107")
            With .Font
                .Name = "Times New Roman"
                .Size = 12
            End With
        End With
    End If
End Sub

Merci pour l'effort de recherche.

Il n'y a plus de mode de débogage. Il y a des conflits dans le worksheet change; cela marche aléatoirement ou l'heure ne s'affiche plus systématiquement. Je vais plancher sur ta proposition et revoir les ranges d'activation de l'heure.

En attendant, j'ai trouvé une solution semi-automatique.

Pour ajouter une ligne dans les cellules renseignées en colonne D :

Dim Cel As Range, Co As Range

Dim Lg As Long

Application.ScreenUpdating = False

Lg = [d65536].End(xlUp).Row

For Each Cel In Range("d14:d" & Lg)

Application.EnableEvents = False

If Cel <> "" Then

Cel.Value = Chr(10) & Cel.Value & Chr(10)

Else: Exit For

End If

Next Cel

Application.EnableEvents = True

Et pour revenir à la normale :

Dim CL As Range

For Each CL In Range("D14:D107")

Application.EnableEvents = False

CL = Replace(CL, Chr(10), " ")

Next

Application.EnableEvents = True

Eventuellement, est-il possible, d'adapter ces macros pour qu'elles s'appliquent à la cellule active?

Merci

bonjour,

je ne dois pas avoir les yeux en face des trou. la macro que je t'ai proposé ajoutait des lignes en colonne C, voici la correction pour la colonne D.

Private Sub Worksheet_Change(ByVal Target As Range)
    Set Target = Intersect(Target, Range("C14:C107"), Me.UsedRange)
    If Not Target Is Nothing Then
        Dim Cel As Range
        For Each Cel In Target
            If Cel <> "" Or Cells(Cel.Row, "B") <> "" Then
                Application.EnableEvents = False
                Cells(Cel.Row, "B") = Now
               with cel.offset(0,1)
                If Left(.value, 1) <> Chr(10) Then .Value = Chr(10) & .Value & Chr(10)
                Application.EnableEvents = true
               end with
            End If
        Next
        With Range("D14:D107")
            With .Font
                .Name = "Times New Roman"
                .Size = 12
            End With
        End With
    End If
End Sub
 

Merci pour le nouvel essai.

Je te renvoie un fichier exemple avec ta proposition, pour que tu puisses constater ce qu'il se produit.

Cela fonctionne parfaitement une fois. Ensuite, le "before double clic" de la feuille modèle n'est plus actif, ni l'heure automatique, ni le saut de ligne.

J'imagine que ça tient à pas grand chose pour que cela marche.

En ligne 13, l'objet flêche permet de faire remonter les lignes, lorsqu'elle est activée, on peut à nouveau voire le saut de ligne fonctionnel mais uniquement une fois.

re-bonjour,

tout à fait bigleux h2so4 , j'ai corrigé le code, voir code dans message précédent

A force de bidouille,

Afin de laisser l'opportunité à l'utilisateur, de lancer les macros à sa convenance et sur la cellule de son choix...

Pour un saut de ligne avant et après :

If activecell <> "" Then

activecell.Value = Chr(10) & activecell.Value & Chr(10)

End If

Pour le retrait des sauts de ligne :

activecell.Value = Application.WorksheetFunction.Substitute(activecell, Chr(10), "")

Je te remercie de m'avoir orienté dans mes recherches.