Améliorer macro

Bonjour

Je reviens vers vous pour un peu d'aide afin de modifier une macro que j'arrive pas à faire.

Voila, j'ai une macro sur double click qui me permet d'ajouter une ligne supplémentaire qui fonctionne très bien, j'aimerai la modifier de manière à ce quelle fonctionne dans une autre macro rattaché sur un click d'un bouton.

'Insertion d'une ligne sup
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 Dim rng As Range, LgFin As Integer
    'on recherche le mot "consignes colonne A
 Set rng = Columns(1).Cells.Find("consignes")
    'si "consignes" est situé deux lignes plus bas
 If Target.Row = rng.Row - 2 Then
    '=> on insère une ligne
    Range("A" & Target.Row + 1 & ":J" & Target.Row + 1).Insert shift:=xlDown
    'copié/collé pour la mise en forme
    Range("A" & Target.Row & ":J" & Target.Row).Copy Range("A" & Target.Row + 1 & ":J" & Target.Row + 1)
 End If
End Sub

J'ai essayé de la copier/coller dans un module en la renomment

Sub Ajoutligne()

If Target.Row = rng.Row - 2 Then

Votre aide serai la bien venue, Si besoin sur demande je joindrai le fichier.

Cdlt

Bonjour

Tu écris :

Si besoin sur demande je joindrai le fichier.

Ce serait plus simple en effet.

Bye !

Bonjour gmb

Voila le fichier.

J'aimerai adapter sur le click du bouton inscription (en vert) de L'UsF_Editer le même principe que la macro au double click en module 1. afin de supprimer le double click.

Merci de ton aide

Cdlt

P.J

Re

j'essai depuis un bon moment d'adapter ce code mais la, je flanche et marche pas, comprends pas. j'ai ajouter un With, End With mais rien n'y fais.

ma modif :

'Insertion d'une ligne sup
 Sub Ajoutligne() 'ESSAI DU Sub
 Dim rng As Range, LgFin As Integer

 With Sheets("Main-Courante")
    'on recherche le mot "consignes colonne A
 Set rng = Columns(1).Cells.Find("consignes")
    'si "consignes" est situé deux lignes plus bas
 If Target.Row = rng.Row - 2 Then
    '=> on insère une ligne
    Range("A" & Target.Row + 1 & ":J" & Target.Row + 1).Insert shift:=xlDown
    'copié/collé pour la mise en forme
    Range("A" & Target.Row & ":J" & Target.Row).Copy Range("A" & Target.Row + 1 & ":J" & Target.Row + 1)
 End If
 End With
End Sub

Pourquoi je n'y arrive pas !!! ça parai simple à priori, zute alors.

Si de l'aide pouvait m'être amené, serai sympas, merci.

Cdlt.

"Target" est un mot réservé que VBA attribue à la cellule active dans une macro événementielle.

Si tu veux obtenir le même résultat dans une macro de module, il te faut remplacer ‘’Target’’ par ‘’ActiveCell’’.

Ce qui donnera :

Sub Ajoutligne() 'ESSAI DU Sub
 Dim rng As Range, LgFin As Integer

 With Sheets("Feuil1")
    'on recherche le mot "consignes colonne A
 Set rng = Columns(1).Cells.Find("consignes")
    'si "consignes" est situé deux lignes plus bas
 If ActiveCell.Row = rng.Row - 2 Then
    '=> on insère une ligne
    Range("A" & ActiveCell.Row + 1 & ":J" & ActiveCell.Row + 1).Insert shift:=xlDown
    'copié/collé pour la mise en forme
    Range("A" & ActiveCell.Row & ":J" & ActiveCell.Row).Copy Range("A" & ActiveCell.Row + 1 & ":J" & ActiveCell.Row + 1)
 End If
 End With
End Sub

Fais l'essai !

OK ?

Bye !

Salut Pompaero,

au-delà de toute autre considération sur le fond, ta macro fonctionne très bien... si tu ajoutais des petits points par-ci, par-là devant ;Range ou .Columns... puisque tu es sous WITH...

With Sheets("Main-Courante")
    'on recherche le mot "consignes colonne A
    Set rng = .Columns(1).Cells.Find("consignes")
     'si "consignes" est situé deux lignes plus bas
    If Target.Row = rng.Row - 2 Then
         '=> on insère une ligne
        .Range("A" & Target.Row + 1 & ":J" & Target.Row + 1).Insert shift:=xlDown
         'copié/collé pour la mise en forme
        .Range("A" & Target.Row & ":J" & Target.Row).Copy Range("A" & Target.Row + 1 & ":J" & Target.Row + 1)
    End If
 End With

A+

Bonjour curulis et gmb

gmb : je me doutais un peu que Target faisait parti du soucis, j'ai pourtant modifié par Range, Cells mais pas pensé du tout ActiveCells.

Sinon vraiment désolé pour vous 2, mais ça ne marche pas chez moi malgré avoir essayé les 2 propositions et même avoir ajouté des .points dans le code de gmb, au cas ou !! comme la indiqué curulis .

Maintenant il se fait tard les yeux clignotent seul, donc je verrai ça tout à l'heure dans la matinée, bonne nuit à vous. Peu être à tout à l'heure.

Bon courage

Cdlt

Bonjour à tous

Ton code que j'ai modifié et que je t’ai adressé fonctionne à condition d’avoir la feuille ‘’Feuil1’’ active.

Dans ce cas, le ‘’With’’ et le ‘’End With’’ n’ont aucune importance et peuvent être supprimés.

En revanche, si tu veux faire fonctionner cette macro en ayant une autre feuille active, ces deux instructions ont toutes leur raison d’être et, comme le signale Curulis, il te faut rajouter des points ici ou là pour se référer à la bonne feuille.

Mais cela ne suffira pas car, dans ce cas-là, la cellule active (ActiveCell) ne sera pas celle de la ‘’Feuil1’’ mais celle de la feuille active… Il n’y a dans un classeur qu’une seule cellule active en même temps !

Il te faut donc un moyen pour te référer à la cellule qui est active lorsque tu actives la ‘’Feuil1’’.

Supposons que ce soit la cellule C6

En ayant la ‘’Feuil2’’ active, si tu lances alors la macro, elle te donnera le résultat souhaité sur la ''Feuil1'' : voir PJ

OK ?

Bye !

Bonjour

Merci pour tes conseils et ta patience, mais suis vraiment désolé après essai toujours pas de résultats sur l'ajout de ligne. J'ai un doute sur mes explications auprès de vous. Je dois vraiment avoir un soucis de compréhension sur ce sujet .

Donc je me permet de repartir de zéro dans mes explications.

Pour confirmer, la "feuil1" ou "Main-Courante" (c'est la même) est la seule active car les autres sont toutes masquées.

J'aimerai dans une macro de module le même principe que ce code sans notifier l'heure.

'Insertion d'une ligne sup
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 Dim rng As Range, LgFin As Integer
    'on recherche le mot "consignes colonne A
Set rng = Columns(1).Cells.Find("consignes")
    'si "consignes" est situé deux lignes plus bas
 If Target.Row = rng.Row - 2 Then
    '=> on insère une ligne
    Range("A" & Target.Row + 1 & ":J" & Target.Row + 1).Insert shift:=xlDown
    'copié/collé pour la mise en forme
    Range("A" & Target.Row & ":J" & Target.Row).Copy Range("A" & Target.Row + 1 & ":J" & Target.Row + 1)
 End If
'Double click à partir de A22 (colonne A) pour afficher l'heure
If Not rng Is Nothing Then LgFin = rng.Row - 1
 If Target.Column = 1 And Target.Row >= 22 And Target.Row <= LgFin Then Target.Value = Time: Cancel = True
End Sub

c'est à dire quand on arrive 2 lignes au dessus du mot "consignes" en C30 (repère pour le code si dessus) une ligne se rajoute après renseignement à l'aide du UsF_Editer, bouton "Inscription" en vert.

J'espère que c'est plus compréhensible comme cela, vraiment vraiment désolé de ma part et merci de votre compréhension.

Je persiste à faire les essais et d'y comprendre quelque chose.

Cdlt

Erreur de ma part.

Le mot "consignes" est en A30 et non en c30.

Nouvel essai.

S'il y a "consignes" écrit en A30 et que la cellule Active est sur la ligne 28, une ligne s'ajoute quand on clique sur le bouton.

Bye !

Bonjour gmb

D'abord, excuse de mon absence depuis quelques jours (travail oblige).

Je viens d'essayer ta proposition cela à l'air de fonctionner si je sélectionne la cellule active manuellement.

J'ai voulu l'inclure dans mon fichier du code (bouton couleur vert de UsF_Editer) mais ne marche pas sauf si je sélectionne la cellule active manuellement.

Je supose que ça viens de la sélection ActiveCell.Row qui ne concorde pas entre mes 2 codes.

Ton code module :

Sub Lancer()
Dim rng As Range
    'on recherche le mot "consignes colonne A
    Set rng = Columns(1).Cells.Find("consignes")
    'si "consignes" est situé deux lignes plus bas
    If ActiveCell.Row = rng.Row - 2 Then
        '=> on insère une ligne
        Range("A" & ActiveCell.Row + 1 & ":J" & ActiveCell.Row + 1).Insert shift:=xlDown
        'copié/collé pour la mise en forme
        Range("A" & ActiveCell.Row & ":J" & ActiveCell.Row).Copy Range("A" & ActiveCell.Row + 1 & ":J" & ActiveCell.Row + 1)
    End If
End Sub

Puis mon code du commandbutton "Inscription" ou j'ai ajouté ton code module.

     'PARTIE CORRESPONDANTE AU BOUTON ENREGISTRER L'EVENEMENT
Private Sub CommandButton1_Click()
Dim dLign As Long
If ComboBox1 = "" Then 'Exit Sub
   MsgBox "L'éditeur est manquant !"
Exit Sub
End If

Lancer  '<--### Ajout d'une ligne quand l'écriture arrive 2 ligne au dessus du mot consignes en A30

If flagModif Then
    Transfert (nLign) 'Copie la valeur des objets dans les colonnes et lignes correspondante
    EffaceTout        'efface les objets après inscription
Else
    dLign = ActiveSheet.Range("B65000").End(xlUp).Row + 1
    Transfert (dLign) 'Copie la valeur des objets dans les colonnes et lignes correspondante
    EffaceTout        'efface les objets après inscription
End If
AutoFitMergedCellRowHeight Range("B" & dLign)
flagModif = False
Label2 = Label2.Caption + 1
Unload Me
Range("J3").Select
End Sub

Pour moi j'imagine un souci d'ActiveCell différent entre les 2 code mais n'arrive pas à le résoudre.

Si non nous sommes sur la bonne vois. Merci

Cdlt