XL 2019 ecriture sur cellules actives

Did25 · 6 Septembre 2021

Bonjour le forum ,je cherche une solution pour colorier des cellules sélectionnées et en même temps écrire sur les cellules de droite un texte .
Actuellement j'utilise cette formule ,le coloriage fonctionne mais l'écriture ne se fait que sur la première cellule .Merci de votre aide
Worksheets("Modèle").Activate
Set selectedCell = Application.ActiveCell
With Selection.Interior
.Color = 5287936
End With
Set selectedCell = Application.ActiveCell
With ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Texte"
End With
End Sub

Phil69970 · 7 Septembre 2021

Re

Pour annuler une action faite avec une macro il faut par programmation refaire le code inverse que la macro à faite.

VB:

Sub AnnuleMaVersion()
Dim i&

Selection.Interior.Color = xlNone

For i = 1 To Selection.Rows.Count
    Selection(i, 2).Value = ""
Next
End Sub

*Cela n'était pas dans la question du départ...

@Phil69970

sylvanu · 6 Septembre 2021

Bonjour Did,
Votre dernier activecell pointe la cellule active.
Donc remplacez cette ligne par simplement .value="texte"l
Sans oublier le point, la cellule sera alors celle définie par le with.
Et supprimez le sélect du with.

Did25 · 6 Septembre 2021

Bonsoir Sylvanu ,le dernier activecell.offset ,je dois l'enlever ? ,en fait sur mon fichier je selectionne les cellules de D7 à F14 et lorsque je lance ma macro celle-ci doit colorier toutes ces cellules puis inscrire un texte dans F7 à F14 . Je suis un peu perdu ,je l'avoue

Wayki · 6 Septembre 2021

Bonjour,
Remplacer :
With ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Texte"
End With
Par :
ActiveCell.Offset(0, 1).value = "Texte"
Inutile de déclarer selectedcell si vous vous en servez pas par contre.
A +

Did25 · 6 Septembre 2021

Bonsoir Wayki ,d'après vos informations ,voilà ce que ça donne :
Worksheets("Modèle").Activate
Set selectedCell = Application.ActiveCell
With Selection.Interior
.Color = 5287936
ActiveCell.Offset(0, 1).Value = "Texte"
End With
End Sub

Malheureusement ça ne fonctionne pas ,j'ai toujours que la première cellule qui inscrit "texte",pas celles de dessous

laurent950 · 6 Septembre 2021

Bonsoir @Did25 , @sylvanu , @Wayki

VB:

Sub test()
Dim FModèle As Worksheet
Set FModèle = Worksheets("Modèle")
Dim selectedCell As Range
    Set selectedCell = FModèle.Range(ActiveCell.Address)
With selectedCell
    .Interior.Color = 5287936 ' Cellule Active Couleur
    '.Value = "Texte" ' Cellule Active Texte
    ' Ligne juste en dessous
    '.offset(1,0).Interior.Color = 5287936  ' Juste sous la Cellule Active Couleur
    .offset(1,0).Value = "Texte"  ' Juste sous la Cellule Active Texte
End With
End Sub

Wayki · 6 Septembre 2021

Did25 à dit:
et en même temps écrire sur les cellules de droite un texte

Cellule de droite = offset(0,1)
Cellule du dessous = offset(1,0)

sylvanu · 6 Septembre 2021

Bonsoir tout le monde,
Ou issu du post #1 et simplifié :

VB:

Sub essai()
    Worksheets("Modèle").Activate
    ActiveCell.Interior.Color = 5287936
    ActiveCell.Offset(0, 1).Value = "Texte"
End Sub

Wayki · 6 Septembre 2021

Après on peut mouliner comme ça pendant des heures, le mieux serait de glisser un fichier.
Si tu veux colorier toute la sélection, peut être essayer de remplacer activecell par selection.
A +

Did25 · 7 Septembre 2021

Bonjour a tous ,en effet il est plus facile de travailler sur un fichier ,le voici ,merci de votre aide et votre patiente .

Phil69970 · 7 Septembre 2021

Bonjour @Did25 , Sylvain, Wayki, Laurent

Je te propose ceci :
* Je suis partis du principe que tu sélectionnes la zone à la souris

Did25 à dit:
une solution pour colorier des cellules sélectionnées

VB:

Sub MaVersion()
Dim i&

Selection.Interior.Color = 5287936

For i = 1 To Selection.Rows.Count
    Selection(i, 2).Value = "Texte"
Next
End Sub

Merci de ton retour

@Phil69970

Did25 · 7 Septembre 2021

Bonjour Phil ,nickel ça fonctionne ,par contre je m'aperçois qu'une fois ma macro exécutée ,je n'ai plus la possibilité de faire un retour arrière ,le fameux control+Z

sylvanu · 7 Septembre 2021

Bonjour Tout le monde,
Une autre solution en automatique, il suffit de sélectionner une zone pour qu'elle se remplisse avec :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Column Mod 4 = 0 Then     ' uniquement si colonnes concernées
        Target.Interior.Color = 5287936 ' mise en couleur
        For Each c In Target            ' dans toute la zone
            If c.Column Mod 4 = 1 Then  ' si colonne de droite
                c.Value = "Texte"       ' insertion texte
            End If
        Next c
    End If
Fin:
End Sub

Mais là aussi le Ctrl Z ne marche pas, pas de Ctrl Z après l'éxécution d'une macro.
A approfondir, peut être une solution va venir.

sylvanu · 7 Septembre 2021

Une V2 :
Si la zone sélectionnée est blanche alors vert et insertion texte, si la zone est déjà verte alors on met en blanc et on efface les textes, avec :

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Interior.Color = 5287936 Then ' si couleur verte
        Couleur = 16777215                  ' alors blanc et texte vide
        Texte = ""
    Else                                    ' sinon vert et texte="Texte"
        Couleur = 5287936
        Texte = "Texte"
    End If
    If Target.Column Mod 4 = 0 Then         ' uniquement si colonnes concernées
        Target.Interior.Color = Couleur     ' mise en couleur
        For Each c In Target                ' dans toute la zone
            If c.Column Mod 4 = 1 Then      ' si colonne de droite
                c.Value = Texte             ' insertion texte
            End If
        Next c
    End If
Fin:
End Sub

Phil69970 · 7 Septembre 2021

Re

Pour annuler une action faite avec une macro il faut par programmation refaire le code inverse que la macro à faite.

VB:

Sub AnnuleMaVersion()
Dim i&

Selection.Interior.Color = xlNone

For i = 1 To Selection.Rows.Count
    Selection(i, 2).Value = ""
Next
End Sub

*Cela n'était pas dans la question du départ...

@Phil69970

XL 2019 ecriture sur cellules actives

Did25

XLDnaute Occasionnel

Phil69970

sylvanu

XLDnaute Barbatruc

Did25

XLDnaute Occasionnel

Wayki

XLDnaute Impliqué

Did25

XLDnaute Occasionnel

laurent950

XLDnaute Barbatruc

Wayki

XLDnaute Impliqué

sylvanu

XLDnaute Barbatruc

Wayki

XLDnaute Impliqué

Did25

XLDnaute Occasionnel

Pièces jointes

Phil69970

XLDnaute Barbatruc

Did25

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

Phil69970

XLDnaute Barbatruc

Discussions similaires