Insérer supprimer ligne depuis USF

  • Initiateur de la discussion Initiateur de la discussion RONIBO
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

RONIBO

XLDnaute Impliqué
Bonsoir le forum,

Je fais encore appel à vous pour m'aider à créer un code (vba) pour un userform.

C'est un userform qui permet de supprimer ou ajouter de(s) ligne(s), que j'ai intégrer dans ma facture.

Voici les détails qui se trouve ci joint (dans une capture d'écran)



Je vous mets mon fichier exemple

Ce lien n'existe plus

Merci aux personne qui vont se pencher sur mon problème 🙂

a+
 
Re : Insérer supprimer ligne depuis USF

Bonjour RONIBO

Vois si cela te convient
 

Pièces jointes

Re : Insérer supprimer ligne depuis USF

Bonjour,

Merci Pierrejean 🙂

J'aimerais corriger deux p'tit truck

Tu vois lorsque j'insère une ligne, il me recopie pas la formule qui se trouve dans la colonne H

Autre correction à faire si possible bien sur

Mettre par défaut "1" dans le textbox, au lieu de reprendre là même quantité saisie précédemment

Merci encore 🙂
 
Re : Insérer supprimer ligne depuis USF

Re

Voila pour la formule en colonne H et le 1 à l'ouverture de l'userform (il faut le fermer et non le cacher !)
Pour la mise en forme : rien constaté . Vérifie et dis-nous (avec fichier exemple S.T.P)
 

Pièces jointes

Re : Insérer supprimer ligne depuis USF

Re,

Merci pierrejean 🙂

Parfait !

Par contre je m'aperçois que ce code ne fonctionne plus 🙁

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Clic en dehors du tableau pour effacer les lignes coloriées
Range("A20:H" & Range("H65535").End(xlUp).Row).Interior.Pattern = xlNone
'Pour la partie désignation
If Not Intersect(Target, Range("Surligneur")) Is Nothing And Target.Count = 1 Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 8)).Interior.Color = RGB(255, 192, 0)
End If

If Not Intersect(Target, Range("Surligneur")) Is Nothing And Target.Count = 4 Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 8)).Interior.Color = RGB(255, 192, 0)

If Len(Cells(Target.Row, 3)) > 60 Then
Cells(Target.Row, 3).RowHeight = 30
Else
Cells(Target.Row, 3).RowHeight = 15
End If

End If

If Not Intersect(Target, Range("Surligneur")) Is Nothing And Target.Count = 1 Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 8)).Interior.Color = RGB(255, 192, 0)
End If
End Sub


ça permet de surligner les lignes (orange)
Mettre en majuscule la première lettre de la colonne "Désignation"
et régler la hauteur des lignes lorsque je dépasse le nombres de caractères défini (toujours pour la colonne désignation)

a+
 
Dernière édition:
Re : Insérer supprimer ligne depuis USF

Je vais t'avoué quelque chose, ce code il me soule ^^

j'ai envie de la changé.

Déjà je me pose la question pourquoi je suis obligé de mettre trois code pour le surligneur

Range("A20:H" & Range("H65535").End(xlUp).Row).Interior.Pattern = xlNone
'Pour la partie désignation
If Not Intersect(Target, Range("Surligneur")) Is Nothing And Target.Count = 1 Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 8)).Interior.Color = RGB(255, 192, 0)
End If

If Not Intersect(Target, Range("Surligneur")) Is Nothing And Target.Count = 4 Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 8)).Interior.Color = RGB(255, 192, 0)

If Not Intersect(Target, Range("Surligneur")) Is Nothing And Target.Count = 1 Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 8)).Interior.Color = RGB(255, 192, 0)
 
Re : Insérer supprimer ligne depuis USF

Re

Vois si cela va mieux
 

Pièces jointes

Re : Insérer supprimer ligne depuis USF

Bonjour François !)
Bonjour le forum,

J'ai trouver une astuce pour utiliser cette macro

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Clic en dehors du tableau pour effacer les lignes coloriées
Range("A20:H" & Range("H65535").End(xlUp).Row).Interior.Pattern = xlNone
'Pour la partie désignation
If Not Intersect(Target, Range("Surligneur")) Is Nothing And Target.Count = 1 Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 8)).Interior.Color = RGB(255, 192, 0)
End If

If Not Intersect(Target, Range("Surligneur")) Is Nothing And Target.Count = 4 Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 8)).Interior.Color = RGB(255, 192, 0)

If Len(Cells(Target.Row, 3)) > 60 Then
Cells(Target.Row, 3).RowHeight = 30
Else
Cells(Target.Row, 3).RowHeight = 15
End If

End If

If Not Intersect(Target, Range("Surligneur")) Is Nothing And Target.Count = 1 Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 8)).Interior.Color = RGB(255, 192, 0)
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Or annul = 1 Then annul = 0: Exit Sub
'Mettre en majuscule des cellules
If Target.Address = "$G$14" Then annul = 1: Cells(14, 7) = StrConv(Cells(14, 7), 1): Exit Sub
'Mettre en majuscule la première lettre
If Not Intersect(Target, Range("NomPropre")) Is Nothing Then annul = 1: Target = UCase(Left(Target, 1)) & Mid(Target, 2): Exit Sub
annul = 0
End Sub

Dans gestionnaires des noms, j'ai changé le "Fait référence" j'ai rajouté une ligne à la fin, au lieu de 38 j'ai mis 39 🙂

Il me manque plus que le problème de mon post 11.

Lorsque j'insére des ligne la formule qui se trouve dans Total HT (celui en bas ou y'a le Total TTC) ne marche que pour
=SOMME(H20:H38)

Pui comme je t'ai dit, si tu as un peu de temps à m'accorder pour me proposer un autre code concernant :

Le surligneur (fond de couleur)
Nom propre (Mettre en majuscule la première lettre de la colonne désignation)
Et ajustement des hauteurs lorsque le texte dépasse la cellule

On utilise ce code pour l'ajustement des hauteurs lorsque on dépasse un certain nombre de caractères (pour la colonne désignation) :

If Len(Cells(Target.Row, 3)) > 60 Then
Cells(Target.Row, 3).RowHeight = 30
Else
Cells(Target.Row, 3).RowHeight = 15
End If

Le problème est que je peux ajuster que sur deux lignes, j'aimerais pas mettre de limite.

un truck de ce genre :

Sub AjusteEnHauteur()
For Each cel In ActiveSheet.UsedRange
If cel <> "" Then
Set m = cel.MergeArea
m.UnMerge
m.WrapText = True 'renvoie à la ligne
m.HorizontalAlignment = xlCenterAcrossSelection
m.Rows.AutoFit
m.Merge
m.HorizontalAlignment = xlGeneral 'facultatif bien sûr
End If
Next
End Sub

Merci encore

a+
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
370
Retour