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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichD
Le #25734892
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
'---------------------------------------------

MichD
--------------------------------------------------------------
JP
Le #25735172
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.

JP
MichD
Le #25735712
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
'-------------------------------------------------



MichD
---------------------------------------------------------------
JP
Le #25736592
Bonjour Denis,

Proposition de maitre!

Merci

JP
JP
Le #25739802
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.

Merci d'avance.

JP
MichD
Le #25740292
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
JP
Le #25740522
Merci Denis, je vais tester en intégrant ma nouvelle feuille à un proje t.

JP
Publicité
Poster une réponse
Anonyme