XL 2019 Macro retour à la ligne dans une cellule

netparty

XLDnaute Occasionnel
Bonjour à tous



Je cherche a modifier mon code mais je ne trouve pas la solution.



Via mon formulaire je choisi une référence de matériel et via ma macro il copie mon choix vers mon listing.

Jusque-là tout va bien , mais j’aimerai pouvoir choisir plusieurs fois une référence et l’insérer de nouveau dans la même cellule sans effacer le contenu existant.

Je voudrai que la macro vérifie si la cellule est non vide et si c’est le cas qu’elle fasse un retour à la ligne pour copier la nouvelle valeur choisie.

Ci-joint mon bout de code



Private Sub Frm_Materiel_copier_indiceA_Click()

'---------------------------------------------------------

'Copier matériels vers LISTING_FT

'Bouton Frm_Materiel_copier_indiceA

'---------------------------------------------------------

Dim LigneActive$

LigneActive = ActiveCell.Row

Cells(LigneActive, 10).Value = Me.textbox3.Value 'Description/commentaire

Cells(LigneActive, 11).Value = Me.textbox6.Value 'Marque

Cells(LigneActive, 12).Value = Me.TextBox5.Value 'référence

Cells(LigneActive, 13).Value = Me.textbox7.Value ' Fournisseur

End Sub



Merci d’avance et bonne journée à tous
 

netparty

XLDnaute Occasionnel
Bonjour Netparty,
essayez cela :
VB:
If Cells(LigneActive, 10) = "" Then
    Cells(LigneActive, 10) = Me.textbox3.Value
Else
    Cells(LigneActive, 10) = Cells(LigneActive, 10) & Chr(10) & Me.textbox3.Value
End If
( Chr(10) peut être remplacé par vbLf qui est la même chose )


Bonjour sylvanu

Merci pour ton aide

Bonne journée
 

soan

XLDnaute Barbatruc
Inactif
Bonjour @netparty, sylvanu,

Attention
Le caractère de déclaration de type est erroné !
Ce n'est pas Dim LigneActive$ mais : Dim LigneActive&
$ : String ; & : Long

Ton code VBA compile, mais il fait une 1ère conversion de type implicite
et inutile avec : LigneActive = ActiveCell.Row ; ensuite, il fait une autre
conversion de type implicite inutile à chaque utilisation de LigneActive,
donc 4 fois.

Mon code VBA n'a pas besoin de LigneActive.
;)
VB:
Private Sub Frm_Materiel_copier_indiceA_Click()
  '---------------------------------------------------------
  'Copier matériels vers LISTING_FT
  'Bouton Frm_Materiel_copier_indiceA
  '---------------------------------------------------------
  Application.ScreenUpdating = 0
  With Cells(ActiveCell.Row, 12)
    .Offset(, -2) = textbox3                  'Description/commentaire
    .Offset(, -1) = textbox6                  'Marque
    If .Value = "" Then
      .Value = textbox5                       '1ère référence
    Else
      .Value = .Value & Chr$(10) & textbox5   'référence suivante
    End If
    .Offset(, 1) = textbox7                   'Fournisseur
  End With
End Sub
soan
 

netparty

XLDnaute Occasionnel
Bonjour @netparty, sylvanu,

Attention
Le caractère de déclaration de type est erroné !
Ce n'est pas Dim LigneActive$ mais : Dim LigneActive&
$ : String ; & : Long

Ton code VBA compile, mais il fait une 1ère conversion de type implicite
et inutile avec : LigneActive = ActiveCell.Row ; ensuite, il fait une autre
conversion de type implicite inutile à chaque utilisation de LigneActive,
donc 4 fois.

Mon code VBA n'a pas besoin de LigneActive.
;)
VB:
Private Sub Frm_Materiel_copier_indiceA_Click()
  '---------------------------------------------------------
  'Copier matériels vers LISTING_FT
  'Bouton Frm_Materiel_copier_indiceA
  '---------------------------------------------------------
  Application.ScreenUpdating = 0
  With Cells(ActiveCell.Row, 12)
    .Offset(, -2) = textbox3                  'Description/commentaire
    .Offset(, -1) = textbox6                  'Marque
    If .Value = "" Then
      .Value = textbox5                       '1ère référence
    Else
      .Value = .Value & Chr$(10) & textbox5   'référence suivante
    End If
    .Offset(, 1) = textbox7                   'Fournisseur
  End With
End Sub
soan


Merci pour votre aide.

Puis-je aussi utiliser ce code pour copier d'un formulaire vers un autre.

Bonne journée
 

netparty

XLDnaute Occasionnel
Sans voir le fichier avec tes 2 formulaires, c'est difficile à dire ; mais en
principe, oui : tu dois pouvoir utiliser le même genre de code VBA. ;)


Bonne journée à toi aussi. :)

soan

Merci voici le code

Formulaire 1 vers formulaire 2

Private Sub BP_import_Mat_FRM_indA_Click()
If Me.textbox3 <> "" Then
Formulaire_FT.TextBox10 = Me.textbox3 'Description /designation
Formulaire_FT.TextBox11 = Me.textbox6 'Marque
Formulaire_FT.TextBox12 = Me.TextBox5 'reference
Formulaire_FT.TextBox13 = Me.textbox7 'fournisseur

Unload Me
'UserForm1.Show
End If
End Sub

Bonne journée
 

soan

XLDnaute Barbatruc
Inactif
Ah, non : avec ce code-là, on ne peut pas utiliser le même genre de code VBA
que précédemment ; la seule petite modification qu'on peu faire est :
VB:
Private Sub BP_import_Mat_FRM_indA_Click()
  If Me.textbox3 = "" Then Exit Sub
  Formulaire_FT.TextBox10 = Me.textbox3 'Description /designation
  Formulaire_FT.TextBox11 = Me.textbox6 'Marque
  Formulaire_FT.TextBox12 = Me.TextBox5 'reference
  Formulaire_FT.TextBox13 = Me.textbox7 'fournisseur
  Unload Me
  'UserForm1.Show
End Sub
... ou essaye peut-être :
Code:
Private Sub BP_import_Mat_FRM_indA_Click()
  If Me.textbox3 = "" Then Exit Sub
  With Formulaire_FT
    .TextBox10 = Me.textbox3 'Description /designation
    .TextBox11 = Me.textbox6 'Marque
    .TextBox12 = Me.TextBox5 'reference
    .TextBox13 = Me.textbox7 'fournisseur
  End With
  Unload Me
  'UserForm1.Show
End Sub
(Je ne me rappelle plus si la technique du With
marche avec un nom de formulaire)


soan
 

netparty

XLDnaute Occasionnel
Ah, non : avec ce code-là, on ne peut pas utiliser le même genre de code VBA
que précédemment ; la seule petite modification qu'on peu faire est :
VB:
Private Sub BP_import_Mat_FRM_indA_Click()
  If Me.textbox3 = "" Then Exit Sub
  Formulaire_FT.TextBox10 = Me.textbox3 'Description /designation
  Formulaire_FT.TextBox11 = Me.textbox6 'Marque
  Formulaire_FT.TextBox12 = Me.TextBox5 'reference
  Formulaire_FT.TextBox13 = Me.textbox7 'fournisseur
  Unload Me
  'UserForm1.Show
End Sub
... ou essaye peut-être :
Code:
Private Sub BP_import_Mat_FRM_indA_Click()
  If Me.textbox3 = "" Then Exit Sub
  With Formulaire_FT
    .TextBox10 = Me.textbox3 'Description /designation
    .TextBox11 = Me.textbox6 'Marque
    .TextBox12 = Me.TextBox5 'reference
    .TextBox13 = Me.textbox7 'fournisseur
  End With
  Unload Me
  'UserForm1.Show
End Sub
(Je ne me rappelle plus si la technique du With
marche avec un nom de formulaire)


soan


Merci

Je fais tester cela.
 

netparty

XLDnaute Occasionnel
Bonjour à tous



Je reviens sur le sujet,

Vos réponse mon était d'une grande aide, mais j'ai une autre question,

est-il possible si dans la première cellule il existe déjà une référence identique de ne pas la copier une deuxième fois.



Merci
 

soan

XLDnaute Barbatruc
Inactif
Bonjour netparty,

C'est possible ; solution n° 1 : regarder si la référence à écrire existe déjà dans la plage
de destination ; si oui, on ne l'écrit pas ; si non, on l'écrit ; solution n° 2 : utiliser la
technique du dictionnaire (Scriptionary) ; mais je ne la connaît pas bien, alors, à toi
de trouver des infos dessus. ;)

soan
 

netparty

XLDnaute Occasionnel
Bonjour netparty,

C'est possible ; solution n° 1 : regarder si la référence à écrire existe déjà dans la plage
de destination ; si oui, on ne l'écrit pas ; si non, on l'écrit ; solution n° 2 : utiliser la
technique du dictionnaire (Scriptionary) ; mais je ne la connaît pas bien, alors, à toi
de trouver des infos dessus. ;)

soan
Bonjour soan

pourrais-tu me montrer un exemple.

Merci
 

soan

XLDnaute Barbatruc
Inactif
Re,

Voici un exemple : post #2

* le nom de la plante est cherché dans la destination par le .Find
* si la plante n'est pas trouvée, on l'ajoute en fin de tableau
* si la plante est trouvée, on modifie sa ligne

Tu peux lire aussi toute la conversation. ;)

Si ça te convient pour appliquer à ton propre exo : OK ; sinon,
tu devrais joindre un fichier exemple (sans données confidentielles).


soan
 
Dernière édition:

netparty

XLDnaute Occasionnel
Re,

Voici un exemple : post #2

* le nom de la plante est cherché dans la destination par le .Find
* si la plante n'est pas trouvée, on l'ajoute en fin de tableau
* si la plante est trouvée, on modifie sa ligne

Tu peux lire tout ce post, et éventuellement toute la conversation.

Si ça te convient pour appliquer à ton propre exo : OK ; sinon,
tu devrais joindre un fichier exemple (sans données confidentielles).


soan
Ci-joint mon fichier pour y jeter un oeil.
Merci d'avance
 

Pièces jointes

  • fichier test.xlsm
    395.2 KB · Affichages: 16

soan

XLDnaute Barbatruc
Inactif
@netparty

Dans ton post #10, tu as écrit : « est-il possible si dans la première cellule il existe
déjà une référence identique de ne pas la copier une deuxième fois. »


Je crois que pour faire ta demande, il faut utiliser seulement la 1ère feuille "DB_IMPORT",
et donc ne pas utiliser la 2ème feuille "LISTING_FT", ni le UserForm "Recherche_materiel" ;
peux-tu le confirmer ? ou faut utiliser la 2ème feuille et / ou le UserForm ?

Si tout se passe sur la 1ère feuille "DB_IMPORT", ta première cellule est donc sur
cette feuille ; mais où ? indique sa référence, par exemple : B5

J'ai bien vu ta colonne G "Référence(s)".

Tu dois préciser quelle est ta demande ; ta couleur jaune ne suffit pas !

Indique les circonstances ; par exemple : je rentre une référence sur la 1ère feuille,
dans telle cellule ; ou : dans le UserForm, je saisis la référence dans la TextBox5
(qui est pour "Référence").

Et ensuite ? est-ce dans la colonne G de la 1ère feuille qu'il faut vérifier si la
Référence existe ou non ? si la Référence existe déjà, on ne fait rien ; mais
si la Référence n'est pas trouvée, on ajoute les données du formulaire ?
c'est ça ? ou autre chose ?

Si c'est ça, précise aussi quelles données du formulaire doivent être copiées ;
toutes les données du formulaire ? ou seulement quelques unes ? précise
lesquelles ! et où ces données du formulaire doivent être copiées ? quelle
est au juste la destination ? sur quelle feuille ? dans quelles cellules ?

soan
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 709
Messages
2 081 774
Membres
101 816
dernier inscrit
Jfrcs