Target.adress sur plusieurs lignes

[Ani60]

Bonsoir,
J'ai créer un formulaire qui s'active en double click sur B2, aucun problème. Je voudrais que ce formulaire s'active sur plusieurs cellules et sur plusieurs lignes. Je sais qu'on peut utiliser la formule case mais quand on a 60 lignes de 42 cellules, c'est un peu compliqué d'indiqué toutes les cellules.
Je joins un exemple avec les cellules qui ont besoin du formulire en jaune.

Merci d'avance pour votre aide
Cordialment
Ani60

 

[phlaurent55]

Re : Target.adress sur plusieurs lignes

Bonjour Ani,

remplace ton code par celui-ci:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("B2:D2,B4:D4,B6:D6,B8:D8")) Is Nothing Then
  UserForm1.Show
  End If
End Sub

à+
Philippe

 

[Ani60]

Re : Target.adress sur plusieurs lignes

Bonjour Ani,

remplace ton code par celui-ci:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Target, Range("B2:D2,B4:D4,B6:D6,B8:D8")) Is Nothing Then
  UserForm1.Show
  End If
End Sub

à+
Philippe

Merci beaucoup,
Ca fonctionne très bien, crois-tu que je peux mettre 60 lignes de 42 cellules sur la meme ligne de "intersect".

Cordialement
Ani60

 

[Robert]

Re : Target.adress sur plusieurs lignes

Bonsoir le fil, bonsoir lr forum,

Ani si tu nous disais de quelle lignes il s'agit on perdrait moins de temps ! Si c'est une plage contiguë il suffit de mettre l'adresse de la plage. Si c'est une plage régulière mais non contiguë une boucle pourrait facilement la définir. Dans l'exemple si-dessous 60 lignes de 42 cellules (de la colonne B à AQ) une ligne sur deux (en partant de la seconde) :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim pl As Range 'déclare la variable pl (PLage)
Set pl = Range("B2:AQ2") 'définit la plage pl
For x = 4 To 120 Step 2 'boucle sur 1es 59 autres lignes (séparées par une ligne vide)
    Set pl = Application.Union(pl, Range(Cells(x, 2), Cells(x, 43))) 'redéfinit la plage Pl
Next x 'prochaine ligne de la boucle
If Not Application.Intersect(Target, pl) Is Nothing Then UserForm1.Show
End Sub

Autre possibilité, tu peux aller à la ligne pour rendre le code plus lisible em mettant " _" (espace, underscore) n'importe où comme par exemple :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("B2:D2,B4:D4,B6:D6,B8:D8 _
        B10:D10,B12:D12,B14:D14,B16:D16 _
        B18:D18,B20:D20")) Is Nothing Then
    UserForm1.Show
End If
End Sub

 

[Ani60]

Re : Target.adress sur plusieurs lignes

Re,
Désolé, j'aurai du noter les vrais lignes: elles vont de M11-BB11, M15-BB15,M19-BB19 ainsi de suite, total 60 lignes. Monfichier est trop gros pour mettre ici et change en fonction de mes recherches et parametrage definitive.
Merci
Cordialement
Ani60

 

[phlaurent55]

Re : Target.adress sur plusieurs lignes

Re,

voici le code adapté à 60 lignes ( 11, 15, 19, .....................247)
et pour les colonnes M----->BB (13 à 54)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim pl As Range
Set pl = Range("M11:BB11")
For x = 15 To 247 Step 4
    Set pl = Application.Union(pl, Range(Cells(x, 13), Cells(x, 54)))
Next x
If Not Application.Intersect(Target, pl) Is Nothing Then
UserForm1.Show
End If
End Sub

à+
Philippe

 

[Ani60]

Re : Target.adress sur plusieurs lignes

Re,

voici le code adapté à 60 lignes ( 11, 15, 19, .....................247)
et pour les colonnes M----->BB (13 à 54)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim pl As Range
Set pl = Range("M11:BB11")
For x = 15 To 247 Step 4
    Set pl = Application.Union(pl, Range(Cells(x, 13), Cells(x, 54)))
Next x
If Not Application.Intersect(Target, pl) Is Nothing Then
UserForm1.Show
End If
End Sub

à+
Philippe

Merci beaucoup pour ton aide
Bye
Ani60

 

[Ani60]

Re : Target.adress sur plusieurs lignes

Re,

voici le code adapté à 60 lignes ( 11, 15, 19, .....................247)
et pour les colonnes M----->BB (13 à 54)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim pl As Range
Set pl = Range("M11:BB11")
For x = 15 To 247 Step 4
    Set pl = Application.Union(pl, Range(Cells(x, 13), Cells(x, 54)))
Next x
If Not Application.Intersect(Target, pl) Is Nothing Then
UserForm1.Show
End If
End Sub

à+
Philippe

Merci beaucoup pour ton aide
J'ai adapté ton code pour qu'il prenne les lignes (à mettre le formulaire) dans une colonne H et je voudrais savoir s'il est possible d'enlever les 2 lignes de code que j'ai mis un commentaire.
je joins le fichier

merci d'avance

 

[phlaurent55]

Re : Target.adress sur plusieurs lignes

Re,

voici le code modifié :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim pl As Range, Cel As Integer
Set pl = Range("B" & Sheets("Feuil1").Range("H20").Value & ":D" &_ Sheets("Feuil1").Range("H20").Value)          ' ne pas  enlever
For x = 21 To Range("H65535").End(xlUp).Row
Set pl = Application.Union(pl, Range(Cells(Sheets("Feuil1").Range("H" & x).Value, 2),_ Cells(Sheets("Feuil1").Range("H" & x).Value, 4)))
Next x
If Not Application.Intersect(Target, pl) Is Nothing Then
UserForm1.Show
End If
End Sub

j'ai modifié la ligne
For x =....................

et "fusionné" ce qui pouvait l'être


à+
Philippe

 

[Ani60]

Re : Target.adress sur plusieurs lignes

Re,

voici le code modifié :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim pl As Range, Cel As Integer
Set pl = Range("B" & Sheets("Feuil1").Range("H20").Value & ":D" &_ Sheets("Feuil1").Range("H20").Value)          ' ne pas  enlever
For x = 21 To Range("H65535").End(xlUp).Row
Set pl = Application.Union(pl, Range(Cells(Sheets("Feuil1").Range("H" & x).Value, 2),_ Cells(Sheets("Feuil1").Range("H" & x).Value, 4)))
Next x
If Not Application.Intersect(Target, pl) Is Nothing Then
UserForm1.Show
End If
End Sub

j'ai modifié la ligne
For x =....................

et "fusionné" ce qui pouvait l'être


à+
Philippe

Merci de ton aide
je vais essayer
bye
Ani60