Monter descendre une image en fonction du nombre de ligne
7 réponses
JP
Bonsoir,
Dans la colonne A je fais augmenter ou diminuer le nombre de lignes.
Quand une valeur est ajout=E9e en colonne A, j'ai une image qui descend de =
15 pixels.
Jusque l=E0 pas de probl=E8me.
En revanche, quand une valeur est supprim=E9e en colonne A, je voudrai que =
l'image remonte de -15 pixels.
Un petit exemple en PJ pour =EAtre clair.
http://cjoint.com/?CJvwhk7e4IZ
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
MichD
Bonjour,
J'ai ajouté ceci Me.Shapes("Rectangle 2").Top = 137.1 à la procédure.
L'image demeure au même endroit lorsque tu supprimes une ligne.
'--------------------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) Dim Nbl As Integer If Not Intersect(Target, Range("C5:C29")) Is Nothing Then Nbl = WorksheetFunction.CountA(Range("C5:C29")) ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select Selection.ShapeRange.IncrementTop 15 ActiveSheet.Shapes.Range(Array("Rectangle 2")).Select Selection.ShapeRange.IncrementTop 15 End If Me.Shapes("Rectangle 2").Top = 137.1 End Sub '---------------------------------------------
J'ai ajouté ceci Me.Shapes("Rectangle 2").Top = 137.1 à la procédure.
L'image demeure au même endroit lorsque tu supprimes une ligne.
'---------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Nbl As Integer
If Not Intersect(Target, Range("C5:C29")) Is Nothing Then
Nbl = WorksheetFunction.CountA(Range("C5:C29"))
ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select
Selection.ShapeRange.IncrementTop 15
ActiveSheet.Shapes.Range(Array("Rectangle 2")).Select
Selection.ShapeRange.IncrementTop 15
End If
Me.Shapes("Rectangle 2").Top = 137.1
End Sub
'---------------------------------------------
J'ai ajouté ceci Me.Shapes("Rectangle 2").Top = 137.1 à la procédure.
L'image demeure au même endroit lorsque tu supprimes une ligne.
'--------------------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) Dim Nbl As Integer If Not Intersect(Target, Range("C5:C29")) Is Nothing Then Nbl = WorksheetFunction.CountA(Range("C5:C29")) ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select Selection.ShapeRange.IncrementTop 15 ActiveSheet.Shapes.Range(Array("Rectangle 2")).Select Selection.ShapeRange.IncrementTop 15 End If Me.Shapes("Rectangle 2").Top = 137.1 End Sub '---------------------------------------------
Non, ce n'est pas ce que je souhaite obtenir. Ce que je veux, c'est ce que fait ce code:
Private Sub Worksheet_Change(ByVal Target As Range) 'Sub essai() Dim Nbl As Integer If Not Intersect(Target, Range("C5:C29")) Is Nothing Then Nbl = WorksheetFunction.CountA(Range("C5:C29")) ' descendre les images If Nbl + 6 > Range("A1").Value Then ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select Selection.ShapeRange.IncrementTop 15 ActiveSheet.Shapes.Range(Array("Rectangle 2")).Select Selection.ShapeRange.IncrementTop 15 Range("A1") = Nbl + 6 Range("C" & Nbl + 5).Select Exit Sub End If 'remonter les images If Nbl + 6 < Range("A1").Value Then ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select Selection.ShapeRange.IncrementTop -15 ActiveSheet.Shapes.Range(Array("Rectangle 2")).Select Selection.ShapeRange.IncrementTop -15 Range("A1") = (Nbl + 6) Range("C" & Nbl + 5).Select Exit Sub End If End If 'Me.Shapes("Rectangle 2").Top = 137.1 End Sub
Mais je pense qu'il doit y avoir une méthode autre et plus courte.
JP
Bonjour Denis,
Non, ce n'est pas ce que je souhaite obtenir.
Ce que je veux, c'est ce que fait ce code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Sub essai()
Dim Nbl As Integer
If Not Intersect(Target, Range("C5:C29")) Is Nothing Then
Nbl = WorksheetFunction.CountA(Range("C5:C29"))
' descendre les images
If Nbl + 6 > Range("A1").Value Then
ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select
Selection.ShapeRange.IncrementTop 15
ActiveSheet.Shapes.Range(Array("Rectangle 2")).Select
Selection.ShapeRange.IncrementTop 15
Range("A1") = Nbl + 6
Range("C" & Nbl + 5).Select
Exit Sub
End If
'remonter les images
If Nbl + 6 < Range("A1").Value Then
ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select
Selection.ShapeRange.IncrementTop -15
ActiveSheet.Shapes.Range(Array("Rectangle 2")).Select
Selection.ShapeRange.IncrementTop -15
Range("A1") = (Nbl + 6)
Range("C" & Nbl + 5).Select
Exit Sub
End If
End If
'Me.Shapes("Rectangle 2").Top = 137.1
End Sub
Mais je pense qu'il doit y avoir une méthode autre et plus courte.
Non, ce n'est pas ce que je souhaite obtenir. Ce que je veux, c'est ce que fait ce code:
Private Sub Worksheet_Change(ByVal Target As Range) 'Sub essai() Dim Nbl As Integer If Not Intersect(Target, Range("C5:C29")) Is Nothing Then Nbl = WorksheetFunction.CountA(Range("C5:C29")) ' descendre les images If Nbl + 6 > Range("A1").Value Then ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select Selection.ShapeRange.IncrementTop 15 ActiveSheet.Shapes.Range(Array("Rectangle 2")).Select Selection.ShapeRange.IncrementTop 15 Range("A1") = Nbl + 6 Range("C" & Nbl + 5).Select Exit Sub End If 'remonter les images If Nbl + 6 < Range("A1").Value Then ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select Selection.ShapeRange.IncrementTop -15 ActiveSheet.Shapes.Range(Array("Rectangle 2")).Select Selection.ShapeRange.IncrementTop -15 Range("A1") = (Nbl + 6) Range("C" & Nbl + 5).Select Exit Sub End If End If 'Me.Shapes("Rectangle 2").Top = 137.1 End Sub
Mais je pense qu'il doit y avoir une méthode autre et plus courte.
JP
MichD
Ceci fait la même chose que ton code :
'------------------------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) Dim Rg As Range If Not Intersect(Target, Range("C5:C29")) Is Nothing Then Set Rg = Range("C" & Range("C30").End(xlUp).Row) Me.Shapes.Range(Array("Rectangle 1", "Rectangle 2")).Top = _ Rg.Offset(3).Top + 1 End If End Sub '-------------------------------------------------
'-------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range
If Not Intersect(Target, Range("C5:C29")) Is Nothing Then
Set Rg = Range("C" & Range("C30").End(xlUp).Row)
Me.Shapes.Range(Array("Rectangle 1", "Rectangle 2")).Top = _
Rg.Offset(3).Top + 1
End If
End Sub
'-------------------------------------------------
'------------------------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) Dim Rg As Range If Not Intersect(Target, Range("C5:C29")) Is Nothing Then Set Rg = Range("C" & Range("C30").End(xlUp).Row) Me.Shapes.Range(Array("Rectangle 1", "Rectangle 2")).Top = _ Rg.Offset(3).Top + 1 End If End Sub '-------------------------------------------------
Dans le code que tu m'as proposé, est-ce qu'il y a une possibilité dans le test if ... then ... end if, d'ajouter quelque chose pour que les lign es contenant des formules ne soient pas comptabilisées? En fait à terme, j'aurais des formules dans la colonne C. Les noms et pr énoms proviendront d'une autre feuille.
Merci d'avance.
JP
Bonjour,
Dans le code que tu m'as proposé, est-ce qu'il y a une possibilité dans le test if ... then ... end if, d'ajouter quelque chose pour que les lign es contenant des formules ne soient pas comptabilisées?
En fait à terme, j'aurais des formules dans la colonne C. Les noms et pr énoms proviendront d'une autre feuille.
Dans le code que tu m'as proposé, est-ce qu'il y a une possibilité dans le test if ... then ... end if, d'ajouter quelque chose pour que les lign es contenant des formules ne soient pas comptabilisées? En fait à terme, j'aurais des formules dans la colonne C. Les noms et pr énoms proviendront d'une autre feuille.
Merci d'avance.
JP
MichD
Bonjour,
Pour que cet événement soit déclenché automatiquement, tu dois saisir directement une donnée dans une cellule ou faire un double-clique dans la cellule. Lorsque tu valides, la macro se déclenche.
J'ai désactivé cette ligne de code : 'If Not Intersect(Target, Range("C5:C29")) Is Nothing Then car la colonne C si elle contient des formules ne déclenchera pas la macro. Si tu veux limiter l'exécution de la macro à une colonne en particulier, tu dois utiliser dans la macro une colonne que tu mets à jour manuellement.
Comme elle est écrite présentement la macro utilisée la dernière valeur de la colonne C sans égard aux formules qu'elle contient. Peu importe la cellule qui est mise à jour manuellement, la macro est déclenchée.
'-------------------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) Dim DerLig As Long 'If Not Intersect(Target, Range("C5:C29")) Is Nothing Then DerLig = Range("C:C").Find("*", LookIn:=xlValues, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row Me.Shapes.Range(Array("Rectangle 1", "Rectangle 2")).Top = _ Range("A" & DerLig).Offset(3).Top + 1 'End If End Sub '--------------------------------------------
MichD --------------------------------------------------------------- "JP" a écrit dans le message de groupe de discussion :
Bonjour,
Dans le code que tu m'as proposé, est-ce qu'il y a une possibilité dans le test if ... then ... end if, d'ajouter quelque chose pour que les lignes contenant des formules ne soient pas comptabilisées? En fait à terme, j'aurais des formules dans la colonne C. Les noms et prénoms proviendront d'une autre feuille.
Merci d'avance.
JP
Bonjour,
Pour que cet événement soit déclenché automatiquement, tu dois
saisir directement une donnée dans une cellule ou faire un double-clique
dans la cellule. Lorsque tu valides, la macro se déclenche.
J'ai désactivé cette ligne de code :
'If Not Intersect(Target, Range("C5:C29")) Is Nothing Then
car la colonne C si elle contient des formules ne déclenchera pas
la macro. Si tu veux limiter l'exécution de la macro à une colonne
en particulier, tu dois utiliser dans la macro une colonne que tu mets
à jour manuellement.
Comme elle est écrite présentement la macro utilisée la dernière valeur de
la colonne C sans égard aux formules qu'elle contient. Peu importe la
cellule qui est mise à jour manuellement, la macro est déclenchée.
'--------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim DerLig As Long
'If Not Intersect(Target, Range("C5:C29")) Is Nothing Then
DerLig = Range("C:C").Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Me.Shapes.Range(Array("Rectangle 1", "Rectangle 2")).Top = _
Range("A" & DerLig).Offset(3).Top + 1
'End If
End Sub
'--------------------------------------------
MichD
---------------------------------------------------------------
"JP" a écrit dans le message de groupe de discussion :
1f738bfa-47f7-43f3-97e8-bc54ca854ea8@googlegroups.com...
Bonjour,
Dans le code que tu m'as proposé, est-ce qu'il y a une possibilité dans le
test if ... then ... end if, d'ajouter quelque chose pour que les lignes
contenant des formules ne soient pas comptabilisées?
En fait à terme, j'aurais des formules dans la colonne C. Les noms et
prénoms proviendront d'une autre feuille.
Pour que cet événement soit déclenché automatiquement, tu dois saisir directement une donnée dans une cellule ou faire un double-clique dans la cellule. Lorsque tu valides, la macro se déclenche.
J'ai désactivé cette ligne de code : 'If Not Intersect(Target, Range("C5:C29")) Is Nothing Then car la colonne C si elle contient des formules ne déclenchera pas la macro. Si tu veux limiter l'exécution de la macro à une colonne en particulier, tu dois utiliser dans la macro une colonne que tu mets à jour manuellement.
Comme elle est écrite présentement la macro utilisée la dernière valeur de la colonne C sans égard aux formules qu'elle contient. Peu importe la cellule qui est mise à jour manuellement, la macro est déclenchée.
'-------------------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) Dim DerLig As Long 'If Not Intersect(Target, Range("C5:C29")) Is Nothing Then DerLig = Range("C:C").Find("*", LookIn:=xlValues, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row Me.Shapes.Range(Array("Rectangle 1", "Rectangle 2")).Top = _ Range("A" & DerLig).Offset(3).Top + 1 'End If End Sub '--------------------------------------------
MichD --------------------------------------------------------------- "JP" a écrit dans le message de groupe de discussion :
Bonjour,
Dans le code que tu m'as proposé, est-ce qu'il y a une possibilité dans le test if ... then ... end if, d'ajouter quelque chose pour que les lignes contenant des formules ne soient pas comptabilisées? En fait à terme, j'aurais des formules dans la colonne C. Les noms et prénoms proviendront d'une autre feuille.
Merci d'avance.
JP
JP
Merci Denis, je vais tester en intégrant ma nouvelle feuille à un proje t.
JP
Merci Denis, je vais tester en intégrant ma nouvelle feuille à un proje t.
