Autofill par VBA
Bonjour au forum,
Je tente d'incrémenter des formules situées dans chaque cellule de 2 plages différentes par macro au fur et à mesure que l'utilisateur remplisse une autre cellule.
Par exemple, lorsque l'utilisateur rempli la cellule B2, il faudrait que les formules en H1, I1, K1 et L1 soient incrémentées en H2, I2, K2 et L2.
Je bloque toujours malgré plusieurs essais...
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim dl As Long
Dim c As Range
Set ws = Sheets("Codage")
dl = ws.Range("B" & Rows.Count).End(xlUp).Row
With ws
For Each c In Range("B3:B" & dl + 100)
If c.Value <> "" And c.Value <> 0 Then
'.Range("H" & dl & ":I" & dl).AutoFill Destination:=Range("H" & dl + 1 & ":I" & dl + 1), Type:=xlFillDefault
.Range("B" & dl & ":M" & dl).Borders.Value = 1
.Range("B" & dl & ":M" & dl).Borders(xlEdgeLeft).Weight = xlThick
.Range("B" & dl & ":M" & dl).Borders(xlEdgeRight).Weight = xlThick
.Range("B" & dl & ":M" & dl).Borders(xlEdgeTop).Weight = xlThin
.Range("B" & dl & ":M" & dl).Borders(xlEdgeBottom).Weight = xlThick
.Range("B" & dl & ":M" & dl).HorizontalAlignment = xlHAlignCenter
.Range("B" & dl & ":M" & dl).VerticalAlignment = xlHAlignCenter
.Range("B" & dl & ":M" & dl).Locked = True
Else
.Range("B" & dl + 1 & ":M" & dl + 100).ClearContents
.Range("B" & dl + 1 & ":M" & dl + 100).Borders.LineStyle = xlLineStyleNone
End If
Next c
End With
Application.ScreenUpdating = True
End SubPour ce test, c'est la ligne en commentaire qui me génère une erreur.
Quelqu'un aurait une idée ?
Bonjour
Cordialement
Oups désolé
Re,
Il y a plus simple et sans macro. Faites comme ceci
- Mettez votre formule à jour en K4
- Sélectionnez B2 à M4
- Dans le menu Accueil, cliquez sur l'icone "Mettre sous forme tableau"
- Choisissez un modèle puis OK
Dès que vous ajouterez une ligne, les formules seront incrémentées automatiquement
Cordialement
edit : Double post
Re,
Merci pour votre réponse Dan.
J'ai malheureusement besoin de faire ceci via une macro, uniquement.
Re
Ok. 3 petites questions
- Pourquoi vous exécutez le code du le changement de sélection
- Pourquoi vous bouclez jusque 100 alors qu'il n'y a pas de données au delà de la ligne DL
- Pourquoi vous rebouclez sur toutes les données et pas agir uniquement sur la ligne où vous ajoutez une donnée
Edit : Remplacez votre code complet par celui-ci puis faites quelques test d'ajout, modification et suppression.
Option Explicit
Dim stopevt As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim dl As Long
Application.ScreenUpdating = False
If stopevt = True Or Target.Count > 1 Then Exit Sub
dl = Target.Row 'définition la ligne
If Target.Value <> "" And Target.Value <> 0 Then
stopevt = True
'Complete les cellules des formules
Range("H" & dl) = Range("B" & dl) & Range("C" & dl) & Range("D" & dl) & Range("E" & dl) & Range("F" & dl)
Range("I" & dl) = Range("C" & dl) & Range("D" & dl) & Range("E" & dl) & Range("F" & dl) & Range("G" & dl)
Range("K" & dl) = Range("B" & dl) & Range("C" & dl) & Range("D" & dl) & Range("E" & dl) & Range("F" & dl)
Range("L" & dl) = Range("B" & dl) & Range("C" & dl) & Range("D" & dl) & Range("E" & dl) & Range("F" & dl)
Range("B" & dl & ":M" & dl).Locked = True
'Mise en forme
With Range("B" & dl & ":M" & dl)
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlHAlignCenter
.BorderAround xlContinuous, xlThin
End With
With Range("B2:M" & dl)
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.BorderAround xlContinuous, xlThick
End With
End If
Application.ScreenUpdating = True
stopevt = False
End SubCordialement
Bonjour à tous,
en retard, mais comme c'est fait je poste.
Je ne m'occupe que des formules, à toi d'adapter si tu veux copier aussi tout ou partie des formats :
Private Sub Worksheet_Change(ByVal Target As Range)
Static b_noEvent As Boolean
Dim c As Range, pl As Range
If Not b_noEvent Then
b_noEvent = True
Set pl = Intersect(Target, Columns(2))
If Not pl Is Nothing Then
For Each c In pl
If Target.Row > 3 And Target <> "" Then
[H3:I3].Copy: Target.Offset(, 6).Resize(, 2).PasteSpecial xlPasteFormulas
[K3:L3].Copy: Target.Offset(, 9).Resize(, 2).PasteSpecial xlPasteFormulas
End If
Next c
Target.Offset(, 1).Select
End If
b_noEvent = False
End If
End SubS'il s'agit d'un collé de plusieurs lignes elles seront toutes traitées.
eric
Edit : Dan, j'ai dans l'idée que ses formules étaient bidons. Alors les mettre en dur.. ;-)
Re,
Je m'excuse pour le temps de réponse, je n'étais pas disponible pour reprendre ce travail.
@Dan : Merci beaucoup pour votre réponse
- Pourquoi vous exécutez le code du le changement de sélection
Car j'aimerais que l'incrémentation des formules ne se fassent que lorsque la cellule de la même ligne en colonne B soit renseignée.
- Pourquoi vous bouclez jusque 100 alors qu'il n'y a pas de données au delà de la ligne DL
C'est probablement très maladroit, mais c'est uniquement pour supprimer le contenu de toutes les cellules de C à M, y compris la mise en forme (bordures), dans le cas où l'utilisateur supprime le contenu de la cellule B.
- Pourquoi vous rebouclez sur toutes les données et pas agir uniquement sur la ligne où vous ajoutez une donnée
Tout simplement car je ne sais pas faire autrement...
Edit : Remplacez votre code complet par celui-ci puis faites quelques test d'ajout, modification et suppression.
Merci beaucoup, je vais tester cela dans la soirée et/ou demain soir
@Eriiic :
Merci beaucoup pour ta réponse également
Je ne m'occupe que des formules, à toi d'adapter si tu veux copier aussi tout ou partie des formats :
Merci également, comme pour la proposition de Dan, je vais tester cela dans les prochaines soirées
Edit : Dan, j'ai dans l'idée que ses formules étaient bidons. Alors les mettre en dur.. ;-)
C'est tout à fait vrai, en réalité, les formules à incrémenter me servent à générer un QR code selon les informations renseignées dans les cellules de B à G.
En H, une formule concatène ces données puis les "chiffrent" selon une fonction.
En I, une formule génère un QR code à partir de la valeur de H qui s'affichera en J (donc chiffré)
En K, une formule déchiffre les données en H selon une autre fonction (uniquement informatif pour moi).
En L, une formule génère un QR code à partir de la valeur de K qui s'affichera en M (donc non chiffré).
Bonjour,
peut-être seras-tu intéressé par ce fil : https://forum.excel-pratique.com/excel/qr-factures-pour-la-suisse-105696
eric
Bonjour
Eriic : Edit : Dan, j'ai dans l'idée que ses formules étaient bidons. Alors les mettre en dur.. ;-)
Nrev : C'est tout à fait vrai, en réalité, les formules à incrémenter me servent à générer un QR code selon les informations renseignées dans les cellules de B à G.
Alors dans mon code proposé vous pouvez remplacer :
Range("H" & dl) = Range("B" & dl) & Range("C" & dl) & Range("D" & dl) & Range("E" & dl) & Range("F" & dl)
Range("I" & dl) = Range("C" & dl) & Range("D" & dl) & Range("E" & dl) & Range("F" & dl) & Range("G" & dl)
Range("K" & dl) = Range("B" & dl) & Range("C" & dl) & Range("D" & dl) & Range("E" & dl) & Range("F" & dl)
Range("L" & dl) = Range("B" & dl) & Range("C" & dl) & Range("D" & dl) & Range("E" & dl) & Range("F" & dl)par la partie du code proposée par Eriic (on aurait peut aussi faire un autofill, mais plus simple comme il propose) :
Range("H3:I3").Copy: Target.Offset(, 6).Resize(, 2).PasteSpecial xlPasteFormulas
Range("K3:L3").Copy: Target.Offset(, 6).Resize(, 2).PasteSpecial xlPasteFormulasJe vous avais mis en dur, car cela évitait la formule et cela donnait la même chose au final. Cette deuxième solution vous impose d'avoir une formule en ligne 3 pour que cela fonctionne.
Bonjour,
peut-être seras-tu intéressé par ce fil : https://forum.excel-pratique.com/excel/qr-factures-pour-la-suisse-105696
eric
Re,
Merci pour ce fil, très intéressant effectivement ! +++
Bonjour
Eriic : Edit : Dan, j'ai dans l'idée que ses formules étaient bidons. Alors les mettre en dur.. ;-)
Nrev : C'est tout à fait vrai, en réalité, les formules à incrémenter me servent à générer un QR code selon les informations renseignées dans les cellules de B à G.
Alors dans mon code proposé vous pouvez remplacer :
Range("H" & dl) = Range("B" & dl) & Range("C" & dl) & Range("D" & dl) & Range("E" & dl) & Range("F" & dl) Range("I" & dl) = Range("C" & dl) & Range("D" & dl) & Range("E" & dl) & Range("F" & dl) & Range("G" & dl) Range("K" & dl) = Range("B" & dl) & Range("C" & dl) & Range("D" & dl) & Range("E" & dl) & Range("F" & dl) Range("L" & dl) = Range("B" & dl) & Range("C" & dl) & Range("D" & dl) & Range("E" & dl) & Range("F" & dl)par la partie du code proposée par Eriic (on aurait peut aussi faire un autofill, mais plus simple comme il propose) :
Range("H3:I3").Copy: Target.Offset(, 6).Resize(, 2).PasteSpecial xlPasteFormulas Range("K3:L3").Copy: Target.Offset(, 6).Resize(, 2).PasteSpecial xlPasteFormulasJe vous avais mis en dur, car cela évitait la formule et cela donnait la même chose au final. Cette deuxième solution vous impose d'avoir une formule en ligne 3 pour que cela fonctionne.
Merci pour cette proposition, qui fonctionne très bien.
J'ai cependant un problème : serait-il possible que l'incrémentation des formules ne se fasse QUE lorsque toutes les cellules de la ligne sont renseignées (donc les cellules de B à G) ? Car pour le moment, à chaque fois qu'une de ces cellules est renseignée, un code barre se génère avec les informations incomplètes.
Second point, dans le cas où une de ces cellules (B à G) est supprimée, est-il possible d'effacer TOUT le contenu (idéalement avec le QR code généré) des cellules de H à M, y compris les bordures ?
Sinon MERCI à vous deux pour votre aide, vous êtes au top dans ce forum
Bonjour
Ok pour la question 1. Il vous suffit de changer ces lignes dans le code
If Target.Row > 3 And WorksheetFunction.CountA(Range("B" & dl & ":G" & dl)) = 6 Then
stopevt = True
'Complete les cellules des formules
Range("H3:I3").Copy: Range("H" & dl).Resize(, 2).PasteSpecial xlPasteFormulas
Range("K3:L3").Copy: Range("K" & dl).Resize(, 2).PasteSpecial xlPasteFormulasQuestion 2
Second point, dans le cas où une de ces cellules (B à G) est supprimée, est-il possible d'effacer TOUT le contenu (idéalement avec le QR code généré) des cellules de H à M, y compris les bordures ?
Avant de vous poster le code, la suppression des bordures n'a de sens que si vous supprimez la dernière ligne et toutes les données entre B & G. Donc si une des cellules entre B&G est supprimée dans le tableau, le code ne supprimera que les données de H & M et pas les bordures. Par contre si vous supprimez toutes les données entre B&G c'est la ligne entière qui est à supprimer.
Je pense qu'il serait plus simple de ne supprimer les données de H à M que si les données ne sont pas complètes entre B&G et de laisser les bordures en place.
Crdlt
Re,
Ok pour la question 1. Il vous suffit de changer ces lignes dans le code
If Target.Row > 3 And WorksheetFunction.CountA(Range("B" & dl & ":G" & dl)) = 6 Then
stopevt = True
'Complete les cellules des formules
Range("H3:I3").Copy: Range("H" & dl).Resize(, 2).PasteSpecial xlPasteFormulas
Range("K3:L3").Copy: Range("K" & dl).Resize(, 2).PasteSpecial xlPasteFormulas
C'est parfait merci beaucoup
Avant de vous poster le code, la suppression des bordures n'a de sens que si vous supprimez la dernière ligne et toutes les données entre B & G. Donc si une des cellules entre B&G est supprimée dans le tableau, le code ne supprimera que les données de H & M et pas les bordures. Par contre si vous supprimez toutes les données entre B&G c'est la ligne entière qui est à supprimer.
Je pense qu'il serait plus simple de ne supprimer les données de H à M que si les données ne sont pas complètes entre B&G et de laisser les bordures en place.
Parfaitement judicieux comme remarque, vous avez entièrement raison ! J'imagine que la difficulté sera de supprimé uniquement les QR codes de la ligne lors du changement d'une des cellules de B à G...
Bonjour
J'imagine que la difficulté sera de supprimé uniquement les QR codes de la ligne lors du changement d'une des cellules de B à G...
Non du tout.
C'est plus facile que je vous replace le code entier. Merci de tester.
Si vous supprimez une donnée entre B et G, cela supprimera les données en H et M. Comme suggéré, les bordures restent en place.
Seule amélioration que je verrais éventuellement c'est que si vous supprimez toutes les données entre B&G à l'intérieur du tableau, le code supprime la ligne, mais est-ce vraiment nécessaire sachant que vous pourrez compléter cette ligne avec de nouvelles données. A voir donc..
Option Explicit
Dim stopevt As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim dl As Long
Application.ScreenUpdating = False
If stopevt = True Or Target.Count > 1 Then Exit Sub
dl = Target.Row 'définition la ligne
If Target.Row > 3 And WorksheetFunction.CountA(Range("B" & dl & ":G" & dl)) = 6 Then
stopevt = True
'Complete les cellules des formules
Range("H3:I3").Copy: Range("H" & dl).Resize(, 2).PasteSpecial xlPasteFormulas
Range("K3:L3").Copy: Range("K" & dl).Resize(, 2).PasteSpecial xlPasteFormulas
'Mise en forme
With Range("B" & dl & ":M" & dl)
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlHAlignCenter
.BorderAround xlContinuous, xlThin
End With
With Range("B2:M" & dl)
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.BorderAround xlContinuous, xlThick
End With
ElseIf Target.Row > 3 And WorksheetFunction.CountA(Range("B" & dl & ":G" & dl)) < 6 Then
Union(Range("H" & dl & ":I" & dl), Range("K" & dl & ":L" & dl)).ClearContents
End If
Application.ScreenUpdating = True
stopevt = False
End SubBonjour Dan,
Merci pour votre réponse.
Votre code fonctionne parfaitement, merci.
Cependant, lors de la suppression d'une des valeurs de B à G, les deux QR code générés précédemment en cellule J et M ne se suppriment pas (ce sont des shapes).
Second point, concernant les bordures, lors de la suppression de toutes les données de B à G, le contenu des cellules de H à M se suppriment bien (hormis les 2 shapes en J et M comme expliqué précédemment), mais j'aimerais que les bordures se suppriment également, car toutes les cellules de la ligne seraient vides.
Merci pour votre patience
Bonsoir
Cependant, lors de la suppression d'une des valeurs de B à G, les deux QR code générés précédemment en cellule J et M ne se suppriment pas (ce sont des shapes).
??? vous n'aviez pas dit qu'il y avait des Shapes mais les valeurs dans les cellules J et M sont supprimées. Dans votre fichier on ne voit pas de Shape... il y a un shape par ligne ?
Pour les bordures, dans votre fichier mettons que vous avez trois lignes (4 lignes avec les titres) et que vous supprimez les valeurs entre B&G de la ligne 2, vous voulez supprimez quoi comme bordures ?
??? vous n'aviez pas dit qu'il y avait des Shapes mais les valeurs dans les cellules J et M sont supprimées. Dans votre fichier on ne voit pas de Shape... il y a un shape par ligne ?
Effectivement, et je m'en excuse. Comme votre aide a dépassé ma question initiale, je n'ai pas pensé à vous donner plus d'éléments...
Je vous joins un fichier anonymisé réel pour plus de facilité.
Pour les bordures, dans votre fichier mettons que vous avez trois lignes (4 lignes avec les titres) et que vous supprimez les valeurs entre B&G de la ligne 2, vous voulez supprimez quoi comme bordures ?
Encore une hypothèse à laquelle je n'avais pas pensé
Probablement qu'une suppression complète de la ligne serait plus judicieuse dans ce cas... ?