Monter descendre une image en fonction du nombre de ligne
Le
JP
Bonsoir,
Dans la colonne A je fais augmenter ou diminuer le nombre de lignes.
Quand une valeur est ajoutée en colonne A, j'ai une image qui descend de =
15 pixels.
Jusque là pas de problème.
En revanche, quand une valeur est supprimée en colonne A, je voudrai que =
l'image remonte de -15 pixels.
Un petit exemple en PJ pour être clair.
http://cjoint.com/?CJvwhk7e4IZ
Qu'elle est la bonne méthode?
Merci d'avance.
JP
Dans la colonne A je fais augmenter ou diminuer le nombre de lignes.
Quand une valeur est ajoutée en colonne A, j'ai une image qui descend de =
15 pixels.
Jusque là pas de problème.
En revanche, quand une valeur est supprimée en colonne A, je voudrai que =
l'image remonte de -15 pixels.
Un petit exemple en PJ pour être clair.
http://cjoint.com/?CJvwhk7e4IZ
Qu'elle est la bonne méthode?
Merci d'avance.
JP
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
'---------------------------------------------
MichD
--------------------------------------------------------------
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
'-------------------------------------------------
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
'-------------------------------------------------
MichD
---------------------------------------------------------------
Proposition de maitre!
Merci
JP
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
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