Selection d'adresses de cellules dans liste d'une feuille vers position réelle

[papapaul]

Bonjour le Forum 😱

Je m'en sors toujours pas, c'est peut-être trop compliqué.
Alors je fais appel à vous pour voir comment on pourrait
faire une macro simple qui ferait ce que j'explique ici.
Ensuite, si on peut, j'essaierais de l'adapter à mon gros truc.

Je fais un choix de cellule, ca me les met en bleu.
J'aurais voulu que quand je clique la cellule A1 qui
est toujours le nom d'une feuille, cette feuille soit
sélectionnée et que par rapport à mon choix,
ce soient bien les "adresses" (C5, D3 par exemple)
qui soient mises en bleu aussi dans cette feuille (ici B)

Ca doit être possible, merci d'avance à ceux qui
sont plus doué que moi (ca, c'est pas dur...😀 )

Bonne journée

 

[Gorfael]

Re : Selection d'adresses de cellules dans liste d'une feuille vers position réelle

Bonjour le Forum 😱

Je m'en sors toujours pas, c'est peut-être trop compliqué.
Alors je fais appel à vous pour voir comment on pourrait
faire une macro simple qui ferait ce que j'explique ici.
Ensuite, si on peut, j'essaierais de l'adapter à mon gros truc.

Je fais un choix de cellule, ca me les met en bleu.
J'aurais voulu que quand je clique la cellule A1 qui
est toujours le nom d'une feuille, cette feuille soit
sélectionnée et que par rapport à mon choix,
ce soient bien les "adresses" (C5, D3 par exemple)
qui soient mises en bleu aussi dans cette feuille (ici B)

Ca doit être possible, merci d'avance à ceux qui
sont plus doué que moi (ca, c'est pas dur...😀 )

Bonne journée

Salut
p'tite modif de ton code 😀

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim X As Long
Dim F_D As Worksheet
If Sh.Name <> "Feuil1" Or Intersect(Target, Columns("A")) Is Nothing Then Exit Sub
'si la sélection ne concerne pas la colonne A de Feuil1 on sort
If Target.Row > 1 Then
'si la cellule sélectionnée n'est pas A1
'Ton code début ---------------------------
   If Left(Target.Value, 1) = "$" Then
        Selection.Interior.ColorIndex = 33
    Else
        Target.Interior.ColorIndex = xlNone
         MsgBox "Vous devez cliquer une adresse !    Sinon choisissez une autre feuille ! ", , "Pour mettre un doublon en couleur dans la feuille d'origine."
     
    End If
'Ton code Fin -----------------------------
Else
'si la cellule sélectionnée est A1
    For Each F_D In Worksheets
        If F_D.Name = Sh.Range("A1") Then Exit For
    Next F_D
    If F_D.Name <> Sh.Range("A1") Then
        MsgBox ("Pas de feuille du nom de " & Sh.Range("A1") & " !!!!")
        Exit Sub
    End If
    'si le nom en A1 ne correspond à aucun onglet on sort
    '1re méthode de validité d'un objet
    
    For X = 2 To Sh.Range("A65536").End(xlUp).Row
        If Sh.Range("A" & X).Interior.ColorIndex = 33 Then
            On Error Resume Next
            '2me méthode de validité d'un objet
            'en cas d'erreur, on continue
            F_D.Range(Sh.Range("A" & X)).Interior.ColorIndex = Sh.Range("A" & X).Interior.ColorIndex
            'on colorie la cellule de la feuille (A1) d'adresse (Ax) de la couleur de AX, mais
            'si l'adresse n'existe pas ($KJ$4 par exemple) Excel n'effectue pas l'instruction et
            'déclenche la gestion des erreurs avec Err.number de rempli et suivant l'instruction
            'avant on continue
            If Err.Number = 1004 Then
            'si l'erreur est une mauvaise adresse
                MsgBox ("la cellule A" & X & "ne contient pas une adresse valide !!!")
                Err.Clear
                Exit Sub
            End If
            'on avertit on efface l'erreur et on sort
            On Error GoTo 0
            'remise en route gestion d'erreur normale
            Sh.Range("A" & X).Interior.ColorIndex = xlNone
            'on efface la couleur de la cellule traitée
        End If
    Next X
End If
End Sub

J'ai pas réellement géré les erreurs, parce que si c'est une autre erreur que 1004 (mais je vois pas laquelle ?) , je ne la traite pas

À mon sens, ta macro n'est pas à la bonne place : elle serait mieux dans le module de classe lié à Feuille1. Mais comme je ne connaît pas ton projet...

le changement sur une simple sélection est toujours source de problème.
sur clic droit ou sur double-clic serait plus approprié

De même, au lieu de fixer la couleur(33) tu pourrais la faire en fonction de celle attribuée à la cellule B1(par exemple)

Enfin, t'a de quoi faire mumuse
A+

 

[bqtr]

Re : Selection d'adresses de cellules dans liste d'une feuille vers position réelle

Bonjour papapaul,

Voici un code à mettre dans le module de la Feuil1 de ton fichier exemple.
Il faut doubleclicker sur A1 comme tu le souhaites.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim cell As Range, Refcel, Plg, UnionPlg
If Target <> Range("A1") Then Exit Sub
For Each cell In Range("A1").CurrentRegion
   If cell.Interior.ColorIndex = 33 Then
      Refcel = Replace(cell, "$", "")
      Plg = Plg & Refcel & ","
   End If
Next
UnionPlg = Left(Plg, Len(Plg) - 1)
Sheets(Range("A1").Value).Range(UnionPlg).Interior.ColorIndex = 33
Sheets(Range("A1").Value).Activate
End Sub

Bon courage pour l'adapter à ton usine nucléaire 😀

A+

Salut Gorfael

 

[papapaul]

Re : Selection d'adresses de cellules dans liste d'une feuille vers position réelle

🙂 Salut, Gorfael, btqr,
Merci beaucoup de votre aide, impressionnant
tout ca avec des commentaires en plus. Ca devrait m'aider 🙄
Je sais pas si j'ai vraiment de quoi faire mumuse,
mais ce qui est sur, c'est que j'ai encore du boulot.
Le temps de rentrer chez moi, de regarder et
je vous tiens au courant.

@+

 

[papapaul]

Re : Selection d'adresses de cellules dans liste d'une feuille vers position réelle

Re bonsoir à tous, 🙂
Que Gorfael m'excuse, j'ai pas eu trop le temps, alors pour l'instant
j'ai commencé par celle qui me semble la moins difficile pour moi.(Merci bqtr)
Problème : comme vous aller voir dans cette version un peu plus élaborée que
la précédente, ma feuille liste est écrasée successivement
en fonction des sélections, donc mettre le code dans la feuille1 ne convient
pas tout à fait puisque sinon faut le remettre à chaque fois.
Alors j'ai légèrement modifié et intégré ça dans le code
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Ca à l'air de fonctionner sauf que si je clique A1 pour la sélection
de feuille, ca laisse la msgbox apparaître ;
faudrait mettre quelquepart dans ce code :
If Target = Range("A1") Then
puis quelquechose comme MsgBox.close ou hide ou clear ou vbYes = True
Mais je sais pas l'écrire. Ni exactement ou.😕
C'est quand même déjà un sacré progrès.
Je ferme la Msg et les couleurs sont bien ou il faut dans la feuille voulue.😀
Quand ce sera résolu, si y en a que ça intéresse, je joindrais une
de mes versions bien plus "chiadées", mais elles sont trop lourdes pour
le moment, donc j'y vais petit à petit.

Merci à tous, encore un peu d'aide peut-être (exigeant moi)
mais de toute facon,je continue à travailler tout ca
Et vous tiens au courant😉

Bonne soirée les XLDeurs.

 

[bqtr]

Re : Selection d'adresses de cellules dans liste d'une feuille vers position réelle

Re,

Ton code modifié :
J'ai rajouté un test si l'on click sur A1 et qu'aucune cellule n'est en bleue.

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim cell As Range, Refcel, Plg, UnionPlg
If Sh.Name = "Liste" Then
  If Target <> Range("A1") Then
       If Left(Target.Value, 1) = "$" Then
            Selection.Interior.ColorIndex = 33
       Else
            Target.Interior.ColorIndex = xlNone
            MsgBox "Vous devez cliquer une adresse !    Sinon choisissez une autre feuille ! ", , "Pour mettre un doublon en couleur dans la feuille d'origine."
       End If
  End If

  If Target = Range("A1") Then
     For Each cell In Range("A1").CurrentRegion
        If cell.Interior.ColorIndex = 33 Then
           Refcel = Replace(cell, "$", "")
           Plg = Plg & Refcel & ","
        End If
     Next
      If Plg = "" Then MsgBox "Aucune adresse de cellule sélectionnée !", vbCritical, "Attention:": Exit Sub
       UnionPlg = Left(Plg, Len(Plg) - 1)
       Sheets(Range("A1").Value).Range(UnionPlg).Interior.ColorIndex = 33
       Sheets(Range("A1").Value).Activate
  End If
Application.EnableEvents = True ' Remise en place de l'intercepteur d'évènement
End If
End Sub

Bonne fin de soirée

 

[papapaul]

Re : Selection d'adresses de cellules dans liste d'une feuille vers position réelle

😉 Bonsoir à tous,
Je crois que ca y est. J'explique le plus simple possible🙄 la petite chose qui me gêne.
A partir de la création de la feuille liste, ca fait bien comme je veux.
Reste le problème de la fonction replace dans thisworkbook
qui marche pas avec 97 (version excel au boulot)

Sinon ca me semble OK.
Histoire de causer, grace à ça, mon Usine est quasi terminée
(hormis le problème ci-dessus).
Principe de base : on colle une feuille même plein de lignes
et de colonnes dans mon truc et y a puka.
Alors pas trop de bla bla. C'est trop gros même zippé.😱
Je joins une petite "photo" de tout ce qu'on peut faire avec.
Si ca intéresse tant mieux, en tout cas j'espère que ca
marchera aussi chez vous. Sinon dites moi.
Dix Milles Mercis à vous. Trop nombreux pour vous citer tous
Vive XLD😛

 

[papapaul]

Re : Selection d'adresses de cellules dans liste d'une feuille vers position réelle

🙁 Décidement je suis trop bête,
J'ai oublié de préciser qu'il n'y a évidement que la photo.😀
Pas moins de 16 pages de codes et très imparfaits, alors......
Sinon je peux vous l'envoyer ou bien vous
regarder dans mes précédents post mais les versions
n'y sont pas complètes.
Bonne soirée😉

 

[bqtr]

Re : Selection d'adresses de cellules dans liste d'une feuille vers position réelle

Bonjour papapaul, le forum,

Une modif qui n'utilise pas la fonction "Replace", mais "Mid" qui est compatible avec Excel 97 (enfin je crois).

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim cell As Range, Refcel, Plg, UnionPlg
If Sh.Name = "Liste" Then
  If Target <> Range("A1") Then
       If Left(Target.Value, 1) = "$" Then
            Selection.Interior.ColorIndex = 33
       Else
            Target.Interior.ColorIndex = xlNone
            MsgBox "Vous devez cliquer une adresse !    Sinon choisissez une autre feuille ! ", , "Pour mettre un doublon en couleur dans la feuille d'origine."
       End If
  End If

  If Target = Range("A1") Then
     For Each cell In Range("A1").CurrentRegion
        If cell.Interior.ColorIndex = 33 Then
             If Len(cell) > 4 Then
                Refcel = Mid(cell, 2, 1) & Mid(cell, 4, Len(cell) - 2)
             Else
                Refcel = Mid(cell, 2, 1) & Mid(cell, 4, 2)
             End If
          Plg = Plg & Refcel & ","
     End If
   Next
      If Plg = "" Then MsgBox "Aucune adresse de cellule sélectionnée !", vbCritical, "Attention:": Exit Sub
       UnionPlg = Left(Plg, Len(Plg) - 1)
       Sheets(Range("A1").Value).Range(UnionPlg).Interior.ColorIndex = 33
       Sheets(Range("A1").Value).Activate
  End If
Application.EnableEvents = True ' Remise en place de l'intercepteur d'évènement
End If
End Sub

Bonne journée à tous

 

[papapaul]

Re : Selection d'adresses de cellules dans liste d'une feuille vers position réelle

😱 Salut bqtr, et merci
J'ai essayé un peu vite fait mais apparement ca change rien.
Ca bug toujours sur
If Target <> Range("A1") Then

J'ai essayé aussi avec la fonction de Mdf/bebere
Refcel = Application.WorksheetFunction.Substitute(cell,"$","")
Je pensais bien avancer :
ca bugger plus sur Replace mais comme avec ton
exemple sur la 1ère ligne en dessous if sh.name = "liste" Then

Donc même avec Application.WorksheetFunction.Substitute
qui remplace bien la fonction replace de 97.
ca rebug au tout début du code.😕
Je finis par me demander si y a pas autre chose que 97 qui gêne.
Pourtant hier soir chez moi (excelXP), tout me semblait bien OK.

J'y vois de moins en moins clair.😡

 

[papapaul]

Re : Selection d'adresses de cellules dans liste d'une feuille vers position réelle

😱 Bonsoir bqtr, bonsoir tous,

Mon truc marche parfaitement bien chez moi mais pas au boulot (excel 97),
Ce serait chouette si un expert qui à 97 sous la main ai le temps de regarder

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name = "Liste" Then
Target.Interior.ColorIndex = 33
If Left(Target.Value, 1) = "$" Then
Selection.Interior.ColorIndex = 33
Else
If Target <> Range("A1") Then
Target.Interior.ColorIndex = xlNone
MsgBox "Vous devez cliquer une adresse ! ", , "Pour mettre un doublon en couleur dans la feuille d'origine."
End If
End If
End If
Dim cell As Range, Refcel, Plg, UnionPlg
If Target = Range("A1") Then
Target.Interior.ColorIndex = xlNone
For Each cell In Range("A1").CurrentRegion
If cell.Interior.ColorIndex = 33 Then
Refcel = Replace(cell, "$", "")
Plg = Plg & Refcel & ","
End If
Next
UnionPlg = Left(Plg, Len(Plg) - 1)
On Error Resume Next
Sheets(Range("A1").Value).Range(UnionPlg).Interior.ColorIndex = 33
Sheets(Range("A1").Value).Activate
End If
Application.EnableEvents = True
End Sub

Ca bug sur Replace, alors en suivant les conseils
Si je mets Application.WorksheetFunction.Substitute
ou bien si j'applique la méthode bqtr (avec Mid)
on va plus loin dans la procédure mais au lieu de retourner sur
la feuille du nom de A1, ca met en bleu tout le CurrentRegion de la feuille liste
et ensuite un débobage sur cette ligne : If Left(Target.Value, 1) = "$" Then

Je pense que le fait d'utiliser Substitute ou Mid provoque une sorte
de conflit pour terminer la boucle entre cette ligne et :
Sheets(Range("A1").Value).Range(UnionPlg).Interior.ColorIndex = 33
Sheets(Range("A1").Value).Activate
End If

Je vois pas trop pourquoi mais c'est l'impression que j'ai,
ou alors c'est ailleurs mais ou ??
J'essaye de comprendre, j'ai besoin de ca pour mon job
et c'est pas demain qu'on va me mettre une autre version Excel.😡
Merci à tous et Bonne Soirée .

 

[bqtr]

Re : Selection d'adresses de cellules dans liste d'une feuille vers position réelle

re,

Ben je sais pas quoi te dire, chez moi (Excel 2003) ca fonctionne correctement, même avec :

Refcel = Application.WorksheetFunction.Substitute(cell,"$", "").

N'ayant pas Excel 97 je ne peux pas tester le code. Tu as mis le code tel quel, sans faire de modification ?

 

[bqtr]

Re : Selection d'adresses de cellules dans liste d'une feuille vers position réelle

re,

Le code que tu as mis dans ton dernier message n'a rien à voir avec ce que je t'ai proposé !!

As tu essayé le code de mon message de 14h09 en remplacant les Mid par la fonction Substitue car cela fonctionne.

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim cell As Range, Refcel, Plg, UnionPlg
If Sh.Name = "Liste" Then
  If Target <> Range("A1") Then
       If Left(Target.Value, 1) = "$" Then
            Selection.Interior.ColorIndex = 33
       Else
            Target.Interior.ColorIndex = xlNone
            MsgBox "Vous devez cliquer une adresse !    Sinon choisissez une autre feuille ! ", , "Pour mettre un doublon en couleur dans la feuille d'origine."
       End If
  End If

  If Target = Range("A1") Then
     For Each cell In Range("A1").CurrentRegion
        If cell.Interior.ColorIndex = 33 Then
             'If Len(cell) > 4 Then
                'Refcel = Mid(cell, 2, 1) & Mid(cell, 4, Len(cell) - 2)
            ' Else
               ' Refcel = Mid(cell, 2, 1) & Mid(cell, 4, 2)
             'End If
             Refcel = Application.WorksheetFunction.Substitute(cell, "$", "")
          Plg = Plg & Refcel & ","
     End If
   Next
      If Plg = "" Then MsgBox "Aucune adresse de cellule sélectionnée !", vbCritical, "Attention:": Exit Sub
       UnionPlg = Left(Plg, Len(Plg) - 1)
       Sheets(Range("A1").Value).Range(UnionPlg).Interior.ColorIndex = 33
       Sheets(Range("A1").Value).Activate
  End If
Application.EnableEvents = True ' Remise en place de l'intercepteur d'évènement
End If
End Sub

😕

 

[bqtr]

Re : Selection d'adresses de cellules dans liste d'une feuille vers position réelle

re,

Dans le code de ton message de 19h20, supprime l'espace en trop dans cette ligne : ( l'espace entre Interior et .ColrIndex = 33)

Sheets(Range("A1").Value).Range(UnionPlg).Interior .ColorIndex = 33

Après cela fonctionne correctement.

A+

 

[papapaul]

Re : Selection d'adresses de cellules dans liste d'une feuille vers position réelle

😱 Bonsoir bqtr, Merci encore,
Pour ce qui est de l'espace interior.colorindex
Il existe bien dans mon message "écrit" 'erreur de saisie' 🙄
mais pas dans le vrai code du fichier joint. Excuse
C'est pas ca le problème.
Oui, j'ai bien vu ton message de 14 h 29 et
j'ai fait des tests avec ta méthode Mid ou Substitute à la maison.
Ca marche aussi parfaitement bien chez moi que chez toi
mais pas au boulot avec 97 😡
En attendant un sauveur, je réessaye dès demain matin avec mon 97
Merci à toi mais la je sèche complètement.
Bonne soirée sur XLD