Macro de Reprise de sélection multipleRésolu

Question

Salut le Forum,
Il est toujours temps de vous souhaiter mes meilleurs voeux 2012.
Perso, j'en ai un que je souhaiterais voir être exhaussé grâce à vous.

Je voudrais copier-coller une sélection multiple de LIGNES ENTIERES, d'un classeur vers un autre. A priori, aucun problème ...
Sub MultiRow()
'Copie GLOBALE de sélection multiple de différentes lignes entières

    'Reprise des lignes sélectionnées
    Range("4:4,6:6,8:8").Select
    
    'Copiage
    Selection.Copy
    'Activation du deuxième Classeur ouvert devant recevoir les copies
    Windows("Classeur2").Activate
    'Dernière ligne non vide (accueil des copies)
    Last = Sheets(1).Range("A65536").End(xlUp).Row
    'Correctif pour la toute première ligne
    If Sheets(1).Range("A65536").End(xlUp).Value <> "" Then Last = Last + 1
    Range("A" & Last).Select
    'Collage
    ActiveSheet.Paste
    'Retour au Classeur source
    Windows("Classeur1").Activate
    'Fin de Copier-Coller
    Application.CutCopyMode = False
    Range("A1").Select
    
End Sub

Sauf que : dans le code     'Reprise des lignes sélectionnées
    Range("4:4,6:6,8:8").Select

Comment entrer automatiquement les valeurs appropriées dans Range("xxxxx").select lorsque l'utilisateur fait sa sélection par les Clic+Ctrl habituels ?

J'ai bien essayé par ActiveCell.row associé à une valeur de cellule en bout de ligne, puis par Worksheet_SelectionChange ou Worksheet_Activate... 
J'ai aussi voulu tenter (bêtement!) de lancer par macro l'éditeur de macro pour "récupérer" la sélection de l'utilisateur. Echec!

Bref, je patauge! Qui aurait une idée SVP ?

Merci
Cordialement

Rataxes64

CerberusPau · Accepted Answer

Encore un petit soucis avec des colonnes avec filtrage (je t'avais pas dit)/
j'ai donc ajouté deux lignes à ton code 
Private Sub traitons(t As Range)
    Dim r As Range, tut As String
    For Each r In t.Rows
        If r.EntireRow.Hidden =  True Then GoTo line1
        If sele "" Then tut "@" Else tut = ""
et
        End Select
line1:
    Next

et tout est renté dans l'ordre sur un filrage actif.

Il faut maintenant "reprendre" pour chacune des lignes de la sélection ("e"), toutes les valeurs de la ligne dans la feuille "Archives", ainsi que dans chacune des feuilles complémentaire "Arch(2)" à "Arch(8)" pour la même valeur de ligne "e", si la valeur en colonne B de la feuille "Arch( n )" n'est pas vide ou  =0: Dans ce cas, on passe à la valeur "e" suivante.

La "reprise" est  copiée dans la première ligne d'un nouveau classeur, pour chacune de ses feuilles "Archives" et Arch(n), et dont le nom est composé des valeurs de la feuille "Archives" en colonne : B, C, D, E, et F (attention, en F c'est une date + heure), séparée du caratère "&". Ce nouveau classeur est alors enregistré sous un chemin précis (exemple dans mon appli C:\InfiltroPass\Archives).

Une fois l'exportation terminée, on trouvera donc x fichiers correspondant au x choix, et contenant en première ligne de chacune de leur feuilles "Archives" à Arch(8), les valeurs correspondantes à celles de chaque choix x.

Comme je te l'ai dit, J'ai entré ma "mixture" telle que je viens de te l'envoyer dans mon appli, 

 ET TOUT MARCHE ! 


En récupérant la valeur "e" dans ma macro d'exportation lancée après les choix faits,ça tourne impeccable (même avec Filtrage actif donc).

Voilà, on peut considérer que l'ojbet de ce post est désormais traité.
"Réponse acceptée", donc.

 Avec tous mes remerciements

Cordialement.
Rataxes64

ucfoutu · Answer

Bonjour,
recommence ton code sans tes activate, select etc... en passant par le "Paste" (de quoi ?) sans "Copy" .....(enfin quoi : tout ce qui est inutile, lourd ... et que tu devrais savoir depuis tout ce temps, quand même !...)  et je te viendrai alors (après ce petit "effort" en aide). 


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Bonjour,
Ucfoutu, je sais que j'ai toujours des progrès à faire, notamment du point de vue du "ménage" dans mes codes.

J'ai avancé un peu, et tu vas probalement trouver que je me compliques la vie.

J'ai ajouté un bouton dans ma feuille source pour lancer la recopie de la sélection. 
Private Sub CommandButton1_Click()
    MultiRow
End Sub
Toujours dans la feuille, j'ai utilisé SelectionChange avec une cellule (C1) pour reprendre les adresses de selection Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With Selection
    Range("C1") = Selection.Address
    End With
End Sub
Mais à chaque clic, l'adresse remonte en C1, même si elle existe déjà... Il va y avoir du boulot là dessus pour supprimer les adresses en doublon en C1, et je ne sais pas trop encore comment attaquer le problème, d'autant que dans l'application finale, on ne pourra PAS sélectionner une ligne directement. Il faudra reprendre l'info ActiveCell.row...

Ensuite j'ai tenté de reprendre le code de la sub MultiRow et de le "simplifier"
Sub MultiRow()
'Copie GLOBALE de sélection multiple de différentes lignes entières

'Reprise des lignes sélectionnées reportées en C1
SEL = Workbooks("Classeur1").Sheets(1).Range("C1").Value

'Copiage de la sélection faite dans le classeur1 (on pourrait s'en passer??)
Workbooks("Classeur1").Sheets(1).Range(SEL).Copy

'Destination du collage dans le classeur2
'Dernière ligne non vide (accueil des copies dans le classeur2)
Last = Workbooks("Classeur2").Sheets(1).Range("A65536").End(xlUp).Row
'Correctif pour la toute première ligne
If Workbooks("Classeur2").Sheets(1).Range("A65536").End(xlUp).Value <> "" Then Last = Last + 1
    'Range("A" & Last).Select
    
'Collage de la sélection faite dans classeur1 vers le classeur2 en première ligne vide
Workbooks("Classeur1").Sheets(1).Range(SEL).Paste Destination:=Workbooks("Classeur2").Sheets(1).Range("A" & Last)
    
End Sub

Mais "propriété ou méthode non gérée par cet objet" sur la dernière ligne : donc, j'ai mal compris l'Aide, et ma syntaxe merde quelquepart! Où est donc mon erreur ?

Je n'ai jamais utilisé la syntaxe "xxx.Paste Destination:=yyy", et ne savais même pas qu'on pouvait se passer de Copy... 
J'attends avec impatience de découvrir ça.

Cordialement
Rataxes64

ucfoutu · Answer

Je suis donc allé directement à ta dernière ligne, donc, sans même lire le reste :
Une suggestion : va donc voir dans ton aide en ligne à quel objet (un seul) peut s'appliquer la méthode Paste que tu utilises !

Par ailleurs : le reproche que je te faisais dans ton code précédent était que tu y utilisais un paste alors qu'aucun Copy n'existait !

Et par ailleurs et surtout : il est parfaitement inutile de passer par un "paste" pour attribuer à une cellule (de quelque feuille) la valeur d'une cellule (de quelque autre feuille) !

Et je te conseille enfin d('apprendre ce qu'est Target dans 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On ne peut sérieusement développer ainsi, sans même savoir ce que l'on écrit et pourquoi on l'écrit.
Or, voilà quelques années que tu "t'y es mis" (je devrais dire "que tu ne t'y es pas mis").
Je refuse d'être complice de cela car la chose durerait longtemps sans que tu commences à apprendre.
Désolé.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

Pour que l'on comprenne ma réaction (que j'estime justifiée) :
1) Voilà plus de quatre ans, CerberusPau, que tu travailles avec VBA/Excel
2) tu as même déposé 7 sources (de qui étaient-elles donc ?)

Tu comprends le paradoxe ?


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Salut,
Bon, à vouloir trop détailler pour essayer d'être clair dans la demande qu'on fait, on risque de passer pour un ignare.
J'avoue que c'est pas agréable, donc on va faire sans détour.

1°) Le job à réaliser par un utilisateur lamba: 
Chaque fois qu'il clique sur une cellule d'une ligne, la ligne entière doit être prise en compte pour sa recopie dans un autre classeur, (dernière ligne vide) quand il clique sur un bouton (Export). Il ne peut PAS sélectionner directement une ligne (en-tête masquées).
Bien sûr les lignes concernées ne seront pas forcément consécutives... donc on est en sélections multiples.

2°) Les codes qu'il semble falloir "nettoyer"
a) "récupérer" les indexes des lignes en question, et sans doublon.
Cellules "relais" dans la feuille1 du classeur1 (source)
en C1 et E1 : Résultats de la macro
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With Selection
        rw = ActiveCell.Row
        If Range("E" & rw) = 1 Then Exit Sub
        Range("C1").Value = Range("C1").Value & ActiveCell.Row & ":" & ActiveCell.Row & ","
        Range("E" & rw) = 1
    End With
End Sub
en D1, formule  =GAUCHE(C1;NBCAR(C1)-1)
(en effet, une ligne dans la macro avec Range("D1").Value = Left(Cells(1, 3).Value, Len(Cells(1, 3).Value) - 1) ne donne pas un résultat exploitable pour une sélection unique(????)
b) "copier/coller" par le bouton "Export".
Code Bouton "Export"
Private Sub CommandButton1_Click()
    MultiRow
End Sub
Code "MultiRow"
Sub MultiRow()

    SEL = Workbooks("Classeur1").Sheets(1).Range("D1").Value
    Range(SEL).Select
    Selection.Copy
    Windows("Classeur2").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Windows("Classeur1").Activate
    Application.CutCopyMode = False
    
End Sub

Là, ça marche, mais, c'est vrai, c'est pas beau, et je n'arrive pas à éviter les select et autre activate. de même je ne sais pas comment ne pas passer par les cellules "relais" C1 et F1, ni éviter la formule en D1... (la déclaration "Etat" ne fonctionne pas...)

Même après quelques années de pratique modeste, on a toujours à apprendre.
Merci de m'aider à m'améliorer.

Cordialement

Rataxes64

ucfoutu · Answer

Tu ne fais que montrer que les rudiments eux-mêmes t'échappent totalement.

1) relis donc ce que je t'ai dit plus haut à propos de Target (et ouvre ton aide VBA ! tu en as sacrément besoin)

2) ton bloc With lui-même est surprenant ! (With de quoi ? de ta sélection ? ===>> mais ton code l'ignore totalement !) ===>> ouvre ton aide VBA sur l'instruction With !

Tu vois ? ce sont les tous premiers rudiments qui te font encore défaut, après tant d'années 
Quand on en aura fini avec ces premiers pas au youpala, on arrivera à d'autres notions, que tu n'as pas acquises non plus !
____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Bonjour,
C'est la dernière ligne qui me donnait du fil à retordre: un seul "ActiveSheet" devant Paste, et plus de select, ni d'Activate.
Sub NewMultiRow()

SEL = Workbooks("Classeur1").Sheets(1).Range("D1").Value
Workbooks("Classeur1").Sheets(1).Range(SEL).Copy
Last = Workbooks("Classeur2").Sheets(1).Range("A65536").End(xlUp).Row
If Workbooks("Classeur2").Sheets(1).Range("A65536").End(xlUp).Value <> "" Then Last = Last + 1
ActiveSheet.Paste Destination:=Workbooks("Classeur2").Sheets(1).Range("A" & Last)
    
End Sub

Reste encore à virer les cellules "relais"... 
Une idée ?

Merci
Cordialement



Rataxes64

ucfoutu · Answer

Désolé, CerberusPau
Vraiment désolé.
Je ne reviendrai dans cette discussion que lorsque tu te seras mis au youpala (me relire) et que tu auras corrigé proprement en conséquence tout ce qu'il convient d'écrire proprement dans ton évènement Worksheet_SelectionChange
Donnant donnant.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Bonjour,
Justement, l'aide Excel montre un exemple de Selectionchange utilisant le "With" DIRECTEMENT ...
Je ne vois pas du tout ce qu'il faudrait que je précise avant...
Evidemment, si RIEN n'est sélectionné dans la feuille, un click sur le bouton Export plante la macro, mais si une cellule est sélectionnée (et chaque fois qu'une nouvelle l'est), le "With SELECTION" dans Worksheet_SelectionChange s'y applique, et donc la macro remonte bien ses résultats dans mes cellules "relais".
Sincèrement, j'aimerais vraiment que tu m'éclaires un peu plus.

Cordialement
Rataxes64

ucfoutu · Answer

montre un exemple de Selectionchange utilisant le "With" DIRECTEMENT .

1) et ce bloc With concerne une fenêtre
2) et je t'ai demandé d'ouvrir ton aide VBA sur l'instruction With

Dans les deux cas, d'ailleurs, la syntaxe n'est pas celle que tu utilises 
et Target ? (tu ne veux pas t'en soucier ? cela te fatigue ? ===>> c'est moi, qui vais commencer à "fatiguer", tu vas voir !)
Au lieu de revenir sans cesse ici ...

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Bonjour,

J'avais bien sûr aussi regardé dans les "instructions", mais je ne vois pas ce qui DOIT être ajouté pour être "propre".

Pourquoi le With Selection, "direct", est-il incorrect dans l'instruction Private Sub Worksheet_SelectionChange ? 
Je croyais que Target était par définition dans cette instruction la Nouvelle Sélection.

Tu montes dans les tours, et je ne sais pas ce que je vais "voir", mais sache que je ne pensais pas te "fatiguer" à éclairer ma lanterne plus avant pour que mon code (qui tourne) soit plus propre. 
Je ne te demandes pas de l'écrire à ma place, mais dans l'Aide je ne vois vraiment pas ce que tu me suggères.

Zen
Cordialement
Rataxes64

ucfoutu · Answer

Alors :
1) bye
2) que dieu t'accompagne et je te souhaite beaucoup de chance et succès.

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Bonjour,

A défaut, Dieu m'a accompagné, et dans sa grande mansuétude Il m'a fait remarquer que le With Selection était en fait tout simplement inutile!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    rw = ActiveCell.Row
    If Range("E" & rw) = 1 Then Exit Sub
    Range("C1").Value = Range("C1").Value & ActiveCell.Row & ":" & ActiveCell.Row & ","
    Range("E" & rw) = 1
End Sub

Je suppose donc que (enfin) mon code est dorénavent propre.

Reste le coeur du problème: Comment se passer des cellules "relais" C1, E+row, et de D1 avec sa formule =GAUCHE(C1;NBCAR(C1)-1) , pour récuprérer SANS doublons la syntaxe (SEL) du Range pour la macro MultiRow à la ligne de code Workbooks("Classeur1").Sheets(1).Range(SEL).Copy
C1 récupère le résultat des sélections successives "Row" fourni par la macro, avec une mise en forme compatible de type x:x,y:y,z:z,etc...

E+row=1, évite une deuxème prise en compte d'une ligne déjà sélectionnée.

D1 est supprimée. La suppression de la dernière virgule en C1 est obtenue par une nouvelle ligne de code
SEL = Left(Cells(1, 3).Value, Len(Cells(1, 3).Value) - 1)

Dans ces conditions, la syntaxe de SEL (sans la dernière virgule) est donc valide et interprétable : Range(x:x,y:y,z:z)
Code final:
Sub MultiRow()

'Reprise des indexes des lignes sélectionnées reportées en C1 moins la dernière virgule
SEL = Left(Cells(1, 3).Value, Len(Cells(1, 3).Value) - 1)

'Copiage de la sélection dans le classeur1
Workbooks("Classeur1").Sheets(1).Range(SEL).Copy

'Destination du collage dans le classeur1
'Dernière ligne non vide (accueil des copies dans le classeur1)
Last = Workbooks("Classeur2").Sheets(1).Range("A65536").End(xlUp).Row
'Correctif pour la toute première ligne
If Workbooks("Classeur2").Sheets(1).Range("A65536").End(xlUp).Value <> "" Then Last = Last + 1
    
'Collage de la sélection dans classeur1 vers le classeur2 en première ligne vide
ActiveSheet.Paste Destination:=Workbooks("Classeur2").Sheets(1).Range("A" & Last)

End Sub

Comment maintenant ne plus avoir à recourir aux cellules C1 et E+row ?

D'autant qu'il faudra pouvoir annuler une sélection faite par erreur (ça ne posera pas de problème en E+rox, mais ce sera plus compliqué pour corriger (SEL) en supprimant par exemple un y:y, au beau milieu de la syntaxe).

Personnellement, je ne vois pas comment faire autrement que de conserver ces cellules ; je m'en remets donc aux vôtres, grises celles-là!

Cordialement

Rataxes64

ucfoutu · Answer

C'est déjà bien que tu aies vu que tu n'utilisais même pas ta sélection, dans ton bloc With 
Te reste un pas à faire : savoir ce que représente Target 
Allez ===>> Bonne lecture.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

Ah (trop vite dit) ===>>
te reste également:
- à analyser le sens de la deuxième ligne dans :
Last = Workbooks("Classeur2").Sheets(1).Range("A65536").End(xlUp).Row
'Correctif pour la toute première ligne
If Workbooks("Classeur2").Sheets(1).Range("A65536").End(xlUp).Value <> "" Then Last = Last + 1
!
- à découvrir que la méthode copy ne saurait s'appliquer à une plage discontinue. (la méthode Paste non plus, ipso facto) !
Etudie bien.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

ou le sens de la première ligne (dans ce que j'ai mis en exergue). Ou alors tu m'expliques dans quelle cas de figure une cellule non vide pourrait être vide (ton si <> "") ! 

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Bonjour, Tu as raison, cette deuxième ligne appelle une précision du commentaire. Au début, le classeur2 ne comporte AUCUNE ligne, la valeur Last renvoyée est égale à 1. Normal. Le collage dans classeur2 sera donc fait à la valeur Last, donc en ligne 1. Jusque là tout va bien. Maintenant, il existe une ligne (1), mais Last va EGALEMENT renvoyer 1. Et là, c'est pas bon car le collage va s'effectuer sur la ligne 1 (donc écraser le précédent) alors qu'il faudrait aller en ligne 2 (Last+1). D'où mon commentaire : 'Correctif pour la toute première ligne et la ligne If <>"" Concernant Target, j'ai regardé l'Aide à SheetSelectionChange évènement et SelectionChange évènement. Peut-être voulais-tu me suggérer d'utiliser par exemple rw= Target.Row au lieu rw=ActiveCell.row ? Mais par ailleurs j'ai constaté que si pour un clic unique sur une cellule d'une ligne, tout "va bien", ça ne fonctionne pas sur une sélection continue dans une colonne (clic gauche de la souris tenu) car seule la première ligne de la sélection est prise en compte. J'ai donc modifié le script comme suit : Private Sub Worksheet_SelectionChange(ByVal Target As Range) For Each cell In Selection rw = cell.Row If Range("E" & rw) <> 1 Then cell.Font.Bold = True cell.Interior.ColorIndex = 6 Range("C1").Value = Range("C1").Value & cell.Row & ":" & cell.Row & "," Range("E" & rw) = 1 End If Next End Sub Détail: J'en ai profité pour passer la sélection prise en compte en gras et y affecter un fond jaune. Par conte, dans ce dernier code, je ne vois pas où utiliser Target... Merci de m'avoir encore répondu. Cordialement Rataxes64

CerberusPau · Answer

Oups!
Je vais me faire "gronder"!
Erreur de copier/coller : Bien sûr il faut remplacer ces vilains rw par cell.Row!
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    For Each cell In Selection
        If Range("E" & cell.Row) <> 1 Then
            cell.Font.Bold = True
            cell.Interior.ColorIndex = 6
            Range("C1").Value = Range("C1").Value & cell.Row & ":" & cell.Row & ","
            Range("E" & cell.Row) = 1
        End If
    Next
    
End Sub



Rataxes64

CerberusPau · Answer

Bonjour,

J'ai fini le Else qui manquait, permettant d'annuler une sélection erronée.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    For Each cell In Selection
        If Range("E" & cell.Row).Value <> 1 Then
            cell.Font.Bold = True
            cell.Interior.ColorIndex = 6
            Range("C1").Value = Range("C1").Value & cell.Row & ":" & cell.Row & ","
            Range("E" & cell.Row).Value = 1
        Else
            Init = Range("C1").Value
            Supr = cell.Row & ":" & cell.Row & ","
            Repl = ""
            Range("C1").Value = Replace(Init, Supr, Repl)
            Range("E" & cell.Row).Value = ""
            cell.Font.Bold = False
            cell.Interior.ColorIndex = xlNone
        End If
    Next
    
End Sub


 Mais je ne trouve toujours pas comment ne pas passer par mes cellules "relais" C1 et E+row...


Cordialement
Rataxes64

ucfoutu · Answer

1) Selection n'est autre que l'objet Target ! (ce que j'essaie de te dire depuis ... depuis ...)
2) tu parcours toutes les cellules de ta sélection ! On se demande bien pourquoi !


A quoi (le but clair et précis, sans mots inutiles) te servent ces "relais" C1 et E+row ?
____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

car moi, vois-tu, j'en suis (et veux rester) à ta demande, telle qu'elle était dans ton tout premier message, à savoir :

Je voudrais copier-coller une sélection multiple de LIGNES ENTIERES, d'un classeur vers un autre. 

Ce qui se fait de manière simple,très facilement, à partir de Target,  pour autant que :
- des LIGNES ENTIERES aient bien été sélectionnées (évidemment)
- que l'on traite différemment selon que Target est ou n'est pas une plage de lignes contigües 
____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Bonjour,

Je dois m'absenter quelques jours où je serai sans Internet.
A dans quelques jours, donc.

Rataxes64

CerberusPau · Answer

Bonjour,

Classeur "Source" = MultiExport.xls
Classeur'Accueil" =  Classeur1.xls
Pour me passer des "cellules relais" dans le claseur "source", j'ai utilisé "Font" (ex "E+row") et Type Etat (ex "C1").

 Dans la feuille1 :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Pour Info:
'Seules les cellules de la colonne A1 peuvent être sélectionnées.
'Feuille1 protégée, Colonne A1 déverrouillée et sélection cellules déverrouillées uniquement
'Target  = Sélection multiple des seules cellules en colonne A1 du classeur "source"

    For Each cell In Selection          '(Reprise de la valeur de ligne Row de chaque cellue sélectionnée dans Mem, et "marquage" de la prise en compte par .Font)
        If cell.Font.Bold = False Then  'Si fonte standard (non sélectionné)
            cell.Font.Bold = True       'Fonte Gras
            cell.Font.ColorIndex = 3    'Fonte Rouge
            MemData.Mem = MemData.Mem & cell.Row & ":" & cell.Row & ","
        Else                            'Si déjà sélectionné : annule la sélection
            MemData.Mem = Replace(MemData.Mem, cell.Row & ":" & cell.Row & ",", "")
            cell.Font.Bold = False      'Fonte Standard
            cell.Font.ColorIndex =  0    'Fonte Automatique
        End If
    Next
    
End Sub

 Dans le module1: Public MemData As Etat
Type Etat       'Activation de la Procédure de mémorisation de donnée
Mem As String   'Mémoire Row (format texte)
End Type

Sub MultiRow()
'Copie GLOBALE de sélection multiple de différentes lignes entières, consécutives ou non

'Reprise des N° de lignes sélectionnées reportées
    If MemData.Mem  = "" Then MsgBox "Aucune sélection!": Exit Sub
    MemData.Mem = Left(MemData.Mem, Len(MemData.Mem) - 1)

'Copiage de la sélection dans le classeur MultiExport
    Workbooks("MultiExport.xls").Sheets(1).Range(MemData.Mem).Copy

'Destination du collage dans le classeur1
    'Dernière ligne non vide (accueil des copies dans le classeur1)
    Last = Workbooks("Classeur1").Sheets(1).Range("A65536").End(xlUp).Row
    'Correctif pour la toute première ligne
    If Workbooks("Classeur1").Sheets(1).Range("A65536").End(xlUp).Value <> "" Then Last = Last + 1
    
'Collage de la sélection dans classeur MultiExport vers le classeur1 en première ligne vide
    ActiveSheet.Paste Destination:=Workbooks("Classeur1").Sheets(1).Range("A" & Last)

'Reset Font Classeur MultiExport
    Range("A:A").Font.Bold = False
    Range("A:A").Font.ColorIndex = 0

'Reset Font Classeur1
    Workbooks("Classeur1").Sheets(1).Range("A:A").Font.Bold = False
    Workbooks("Classeur1").Sheets(1).Range("A:A").Font.ColorIndex = 0

'Reset de Mem
    MemData.Mem = ""

End Sub

J'arrive donc de cette manière à (enfin) atteindre mon objectif Je voudrais copier-coller une sélection multiple de LIGNES ENTIERES, d'un classeur vers un autre.
Mais je ne sais pas fairede manière simple,très facilement, à partir de Target

J'atteinds donc ici ma limite d'autodidacte, et espère ne pas abuser en sollicitant un niveau supérieur pour pouvoir progresser, et maîtriser "Target".

Cordialement
Rataxes64

ucfoutu · Answer

Bon.
Que préfères-tu de ces deux propositions :
proposition 1 : je te donne l'essentiel de la méthode (te guide) et tu développes/travailles
proposition 2 : je t'écris tout
Fais ton choix et je réagirai plus vite que mon ombre. 


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

Et ?
Je vais apparemment beaucoup plus vite que toi, pour réagir,
J'ai eu le temps de tout faire en moins de 5 minutes :
code commenté (la méthode) :
Tu le veux complet (donc avec code) ou seulement les commentaires (donc méthode) ?
Fais vite ! je dois sortir. 



____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

Allez, va (il faut que je prenne ma douche avant de sortir) ===>> la totale dans cet exemple bâclé (code et méthode) :
Dim titi As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Set titi = Target
End Sub

Private Sub CommandButton3_Click()
 If verifie_selection(titi) Then
   ajouter_a_feuille titi, ThisWorkbook.Worksheets("Feuil3")
 End If
 Set titi Nothing: encours True
 
End Sub
Private Function verifie_selection(ByVal titi As Range) As Boolean
 If Not titi Is Nothing Then
   ' et il faut vérifier ici que titi n'est composé que de lignes entières (et cela se fait en 1 seule ligne de code)
   'et (et seulement si oui) ===>>
   ' il faut alors vérifier qu'aucun rang de cette sélection n'est jaune (déjà fait)
   'et (et seulement alors) ===>>
   ' verifie_selection = True
  
    
    
    If Not titi.Address Like "*[A-Z]*" Then
      verifie_selection = True
      ' verifions que pas de jaune
      Dim a As Range
      For Each a In titi.Rows
        If a.Interior.ColorIndex 6 Then MsgBox "jaune": verifie_selection False: Exit Function
      Next
    End If
 End If
 
End Function

Private Sub ajouter_a_feuille(titi As Range, feuille As Worksheet)
  'ici :
  '1)ajouter à la feuille de destination (toujours après la dernière ligne remplie) le contenu
  ' de chaque aire (area) de la plage titi
  '2) une fois 1) fait : mettre en jaune la ligne copiée (dans la feuille source)
  
  feuille.Range("A" & Rows.Count).Value = Chr(0)
  Dim a As Range
  For Each a In titi.Areas
    a.Copy Destination:=feuille.Range("A" & feuille.Range("A:A").SpecialCells(xlCellTypeBlanks).Row)
    a.Interior.ColorIndex = 6
  Next
  feuille.Range("A" & Rows.Count).ClearContents
End Sub

je travaille ici sur Feuil1 et je copie vers Feuil3 du même classeur
Toi : change tes noms de feuille pour corresponbdre aux tiennes
et change :
 ajouter_a_feuille titi, ThisWorkbook.Worksheets("Feuil3")
par
 ajouter_a_feuille titi, workbooks("classeur_destination").Worksheets("Feuil3")
Et voilà.
Adapte (si peu) au besoin !
Bon appétit.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Bonjour,

Effectivement, J'étais en train de chercher à ma documenter plus avant sur Target...
Merci de m'indiquer Tu le veux complet (donc avec code) ou seulement les commentaires (donc méthode)

Cordialement
Rataxes64

CerberusPau · Answer

AAhrrr!
Trop vite : Erreur de copier coller :
[quote]le veux complet (donc avec code)quote



Cordialement
Rataxes64

ucfoutu · Answer

Bon../.
Dans ma précipitation, j'ai oublié d'insérer des messageboxes (fais-le) pour
- signaler qu'une sélection est refusée si :
--- pas de lignes entières uniquement
--- reprend une ligne déjà traitée (donc jaune).
Tu sauras faire çà ? (j'espère).

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

T'as eu tout , non ?


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Bonjour,

Nos messages se sont croisés. Effectivement j'ai "tout eu", même une belle méthode en prime!
Bon, je ne m'attendais pas à tout ça ; ayant dû m'absenter, je me remets au boulot.

Donc, A suivre pour la mise "à ma main".

Cordialement
Rataxes64

ucfoutu · Answer

Oh, tu sais ... "belle méthode" ... ===>> juste une, parmi d'autres possibles, c'est tout 


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Heuh,

Allez. J'ose...
La méthode "finale" que j'ai indiquée , elle est vraiment à côté de la plaque ? 
Quelle(s) critique(s) majeure(s) lui fais-tu ?

Cordialement
Rataxes64

ucfoutu · Answer

Tu peux oser et je suis même heureux de constater que tu as travaillé 
Aucune si tu en es satisfait et qu'elle te protège contre tout, y compris les risques de copier deux fois une même ligne.
A toi de voir, selon ton but.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Bonjour,

Après 8 jours, je n'arrive pas à mettre ta méthode en place: J'ai un problème avec
If Not titi.Address Like "*[A-Z]*" Then

Après maints essais restés infructueux, un nouveau problème est soudainement apparu avec WorkSheet_Change, a priori sans raison apparente, dans le code ci-dessous qui jusque là tournait normalement dans mon appli:
Dans la feuille "Général":Private Sub Worksheet_Change(ByVal Target As Range)
'Agent Reset
If Sheets("Data").Range("AS12").Value = 1 then Exit sub    
If Not Intersect(Target, Range("E48")) Is Nothing Then
'ça bloque dès la ligne ci-dessous, qui n'est plus exécutée!!
        Sheets("Data").Range("AS12").Value = 1
        '% de Hauteur Totale par défaut
        If Sheets("Général").Range("K48").Value "+" Then Sheets("Général").Range("R38").Value 10    'Ascendant  (10%)
        If Sheets("Général").Range("K48").Value "Q" Then Sheets("Général").Range("R38").Value 100   'Aucun      (100%)
        If Sheets("Général").Range("K48").Value "," Then Sheets("Général").Range("R38").Value 90    'Descendant (90%)
        'Mélange/Interface
        Sheets("Général").Range("K50").Value = "OUI"
        Sheets("Data").Range("AS12").Value = 0
    End If
Sachant que AS12 permet de quitter la Private Sub, 
que K48 reprend une liste dans la feuille Général (validation / liste = Plage), 
et que R38 et K50 sont des listes (validation / liste = Valeurs).
Bien entendu, tout est déprotégé, et les messages d'alerte des listes désactivés
Bizarrement, la macro Private Sub stoppe (se termine et quitte) dès le premier .Value ????
En reprenant très exactement ce script dans un nouveau classeur : Tout est OK. 
Mais ça ne fonctionne plus si j'ouvre mon appli en même temps...
Qu'est-ce que je dois comprendre : Que mon appli est désormais corrompue ? 
Mais comment trouver où et y palier ?

Là, je rame complet...
L'appli pèse 3Mo et comporte un grand nombre de macro, formules, formats conditionnels... j'aimerais ne pas avoir à tout recommencer...

Cordialement
Rataxes64

ucfoutu · Answer

Après 8 jours, je n'arrive pas à mettre ta méthode en place: J'ai un problème avec

    If Not titi.Address Like "*[A-Z]*" Then 

Cela veut probablement dire que tu n'as pas recopié convenablement ou intégralement mon code, testé sans faille chez moi !
Quant à ton nouveau problème, tu seras bien le seul à pouvoir en trouver la cause, car, pour la trouver, il faudrait maintenant avoir avoir l'intégralité de ton classeur sous les yeux.
Je note simplement ceci (de mémoire) : tu n'as pas appliqué ma méthode et tu t'es donc probablement obstiné à passer par tes "tremplins", dont l'un, si ma mémoire est bonne, avait pour objet d'écrire un "1" dans une cellule. De là à parier que tu as joliment "réussi", dans cette curieuse gestion de "tremplins" inutiles, à mettre un "1" là où tu n'en veux pas dans l'évènement W>orkSheet_selection_change et que ce "1" rentre en conflit avec ton évènement WorkSheet_Change, il n'y a qu'un pas.
Il n'y a qu'un pas, mais ce n'est qu'une supposition.
A ce niveau, vois-tu, je te laisse là, en te répétant que le code que je t'ai donné plus haut a été testé et retesté sans faille chez moi et que si tu continues à en faire un autre pour en suite te demander (et nous demander !) ce qui bloque, alors continue donc seul. 


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

Une chose est certaine, TRES CERTAINE :
pour que cette ligne de mon code :
If Not titi.Address Like "*[A-Z]*" Then 

bloque dans l'évènement commandbutton1_click , il n'y a que 2 explications possibles :
- soit tu as omis de déclarer (comme je l'ai fait) titi en Range dans la partie générale.
- soit tu n'as pas recopié exactement ce que j'ai écrit dans l'évènement selection_change !

Voilà.
____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Bonsoir,

Pourquoi penses-tu que je ne prends pas en compte tes réponses???
Bien sûr que SI ; et je suis dessus depuis plusieurs jours pour comprendre pourquoi en copiant EXACTEMENT ton code, ça ne marche pas.

Comme tu n'arrêtes pas de me le faire remarquer, je ne maîtrise pas le paramètre Target, et je recourre à des stratagèmes qui te déplaisent. J'essaie, avec mes petits moyens, d'au moins concrétiser mon problème avec du code, nul probablement, mais qui permet aux "sachants" de bien cerner ma question.

Contrairement à ce que tu penses, j'ai bien créé un classeur avec 3 feuilles et un bouton, puis renseigné une dizaine de lignes en feuil1. Ton code est copié intégralement dans la feuil1 (en Private).

1°) Le problème rencontré avec :If Not titi.Address Like "*[A-Z]*" Then
 vient du fait qu'il faut sélectionner la ligne entière depuis la colonne des N° de ligne, et non à partir de la cellule de la ligne en colonne A (dans mon cas, les N° de ligne et de colonnes sont masqués).
Je n'ai pas su comment adapter ton code pour faire ça (1ère ou cellule quelconque de la ligne).

2°) En laissant donc les N° de lignes visibles, et en sélectionnant donc "facilement" une ligne complète (ou plusieurs avec Ctrl), ça plante là :'Erreur d'exécution '1004'
'Pas de cellules correspondantes

  For Each a In titi.Areas
>>    a.Copy Destination:=feuille.Range("A" & feuille.Range("A:A").SpecialCells(xlCellTypeBlanks).Row)
        a.Interior.ColorIndex = 6
  Next

NORMAL :Feuille... est vide!feuille.Range("A" & Rows.Count).Value = Chr(0)
J'ai essayé de modifier en nommant directement la feuille active : Wallou, parce que là c'est ici que ça replante 
 If verifie_selection(titi) Then
>>   ajouter_a_feuille titi, ThisWorkbook.Worksheets("Feuil3")
 End If
Mais pourquoi!!! 
Si tu le souhaites, je peux te passer le petit fichier en question (il pèse que dalle).

Quant à mon autre remarque, c'est une AUTRE Private Sub (Worksheet_CHANGE, et non pas SELECTIONCHANGE) qui merde, et celle-là n'a rien à voir avec l'objet initial de ma demande.
La macro se perd en exécution quelques millisecondes : Pas le temps de voir, et le pas à pas avec F9 ne répond pas. Bref, je ne vois pas ce qui peut se passer, parce que le script est pourtant des plus classiques. Mais je vais faire un post à part.

Cordialement
Rataxes64

ucfoutu · Answer

Ben mon vieux ...
Et tu ne pouvais pas le dire avant, que ton problème était que tu ne savais pas sélectionner une ligne entière du fait du masquage des titres le lignes et colonnes ?
Alors :
on se place dans la première cellule d'une ligne ===>> on appuie sur MAJ, que l'on maintient pressée ===>> touche fin ===>> flêche droite ===>> on lâche tout !


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

ou encore (autre manière)

on se place dans la première cellule de la ligne et on appuie simultanément 
CTRL, MAJ et flèhce droite 
____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

OK ucfoutu,

Ces raccourcis clavier ne sont pas toujours connus des utilisateurs Lamba.

Pour eux, un simple clic sur une ligne est quand même plus convivial, non?

D'où ma volonté de faire ça par macro (c'est ce que j'ai écrit dans mon code de débutant et que je n'ai pas trouvé comment faire dans le tien).

Mais à part ça, peux-tu me dire pourquoi
feuille.Range("A" & Rows.Count).Value = Chr(0)

reste vide et que ça plante comme indiqué plus haut?

Merci
Rataxes64

ucfoutu · Answer

Cette ligne restera toujours vide, sauf un très bref instant où elle contient un caractère totalement invisible !
la vocation de :
feuille.Range("A" & Rows.Count).Value = Chr(0)
est très particulière. Elle permet de déceler la première ligne vide de la feuille sans passer par ce par quoi tu passes, à l'aide de
SpecialCells(xlCellTypeBlanks).Row)



____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

Je ne parviens toutefois pas à comprendre certains aspects de ce que tu veux faire :
1) pourquoi avoir masqué les titres de tes lignes et colonnes ? (mais ce n'est qu'accessoire)
2) tout ce qui est mis dans sélection_change s'exécute automatiquement à chaque sélection, que l'utilisateur sélectionne une ligne complète ou non ! Et ton résultat doit correspondre à des lignes complètes.
A moins que tu ne veuilles obliger l'utilisateur, au prétexte de lui faciliter la vie, à systématiquement avoir toutre une ligne sélectionnée à chaque déplacement sur sa feuille ?
Si c'est le cas (étonnant) alors regarde ce que fait ceci :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Target.EntireRow.Select
End Sub

mais ce faisant, comment pourrait-il ne saisir ensuite qu'une seule cellule ?
Tout cela me parait vraiment tortueux, voire dangereux, quelle que soit la méthode.
Ne crois-tu alors pas plus raisonnable (et je te fabrique la chose en moins de trente secondes) d'utiliser un bouton de commande (ou autre) pour passer d'un état "normal" à un état de "sélections forcées de lignes entières en vue de ta copie d'une feuille à l'autre" ?


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

J'avais du temps et ai donc regardé ton autre problème
ton code, pour mémoire :
Private Sub Worksheet_Change(ByVal Target As Range)
'Agent Reset
If Sheets("Data").Range("AS12").Value = 1 then Exit sub    
If Not Intersect(Target, Range("E48")) Is Nothing Then
'ça bloque dès la ligne ci-dessous, qui n'est plus exécutée!!
        Sheets("Data").Range("AS12").Value = 1
        '% de Hauteur Totale par défaut
        If Sheets("Général").Range("K48").Value "+" Then Sheets("Général").Range("R38").Value 10    'Ascendant  (10%)
        If Sheets("Général").Range("K48").Value "Q" Then Sheets("Général").Range("R38").Value 100   'Aucun      (100%)
        If Sheets("Général").Range("K48").Value "," Then Sheets("Général").Range("R38").Value 90    'Descendant (90%)
        'Mélange/Interface
        Sheets("Général").Range("K50").Value = "OUI"
        Sheets("Data").Range("AS12").Value = 0
    End If

Si j'ai bien deviné ce que tu cherches à faire : tu chercherais à invalider les instructions de cette procédure en mettant à "1" la cellule AS12 ? (1 = invalidation, sinon validatrion) ?
C'est celà ? === >> car si oui :
au moment même où tu saisis "1" dans la cellule AS12, que ce soit manuellement  ou par code , tu déclenche l'évènement Change.
Or, je vois cette ligne :
Sheets("Data").Range("AS12").Value  = 1

elle modifie AS12 ===>> la procédure Change est alors déclenchée à nouveau ===>>
Or, sa première ligne est :
If Sheets("Data").Range("AS12").Value = 1 then Exit sub   


Etonne-toi donc, ensuite de ce que "cela ne marche pas". 
Utilise donc une variable booléenne générale, en lieu et place de cette cellule, et tout sera moins "acrobatique" 
____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Bonjour,

Merci, je mets mes cellules grises en route avec 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Target.EntireRow.Select
End Sub
N'empêche que je n'arrive toujours pas à faire tourner ta méthode (plantages décris plus haut)...
Je ne parviens toutefois pas à comprendre certains aspects de ce que tu veux faire  L'utilisateur Lamba doit Exporter des données qui sont rangées en ligne dans des feuilles "Archives" (j'en ai 8 en tout, et il ne voit que la première), et dont seules  quelques colonnes sont visibles (certaines avec filtre). 
Il n'a à sa disposition aucun menu, pas de colonne ni de ligne, ni de barre de formule, ni même d'onglet ; mais seulement un bouton "Exporter" et un bouton "Quitter".
Dans la première colonne est donné le N° de l'Archive. Un premier clic sur une quelconque cellule d'une ligne la "sélectionne" pour être Exportée : Le N° passe en gras et rouge. 
Un autre clic sur une ligne déjà sélectionnée la "désélectionne" (N° au format standard). 
Bien sûr, la "sélection" doit aussi pouvoir être prise en compte par un clic maintenu + déplacer la souris. 
Il ne lui reste plus qu'à cliquer le bouton Exporter pour que la macro associée exporte chaque ligne concernée (de chaque feuille Archive). 
J'ai limité ma question au problème de selection/copy initial pour réaliser cette exportation qui consiste en une création de fichier contenant chacun les valeurs contenues dans chacune des lignes sélectionnées. .

A suivre donc...

Pour l'autre problème, j'ai préféré créer un autre post ici


Cordialement
Rataxes64

ucfoutu · Answer

Ce sont tes boutons exporter et quitter (que l'on peut d'ailleurs réduire à un seul bouton en "switch") qu'il te faut utiliser en modification d'état (comme j'y ai fait allusion plus haut).
Je crois vraiment que le plus simple est que tu mettes ton fichier à ma disposition et tu verras.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

Si tu le mets à disposition, n'oublie pas de le dégrader pour versions depuis 97 (en .xls, donc), afin que tous puisent y accéder, quelle que soit leur propre version.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Heuh,

On fait comment pour que je t'envoie mon fichier ?
Tu peux me donne ton mail en MP, STP ?

Cordialement
Rataxes64

ucfoutu · Answer

Je veux bien, mais si tu fais ainsi, je serai absolument seul à pouvoir suivre valablement cette discussion ! Et on s'éloignera une fois de plus de l'esprit "forum" !
Si tu y tiens vraiment, d'accord et je te communiquerai une adresse email.
Mais je préfèrerais de très loin que tu mettes ton classeur à disposition de tous sur un site ad hoc ! Il y en a plein, parmi lesquels choisir ! et que tu nous en donnes le lien !


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

Enfin quoi :
Tu vas sur Google (par exemple) ===>> ru cherches avec 
sites dépôt de fichiers
tu choisis toi-même le site (je ne ferai la pub d'aucun d'entre eux et ne veux même pas me mêler de ce choix, en précisant que je ne fais personnellement TOTALEMENT confiance à AUCUN d'entre eux)
=>> une fois ton choix fait ===>> tu déposes ===>> tu nous dit où TU as CHOISI de déposer (le lien de ton dépôt)


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

Et pour que tu comprennes mieux : une fois connu ce dépôt, ce ne sera pas de la machine sur laquelle je développe (celle d'où je te réponds en ce moment-même) , que je téléchargerai ton fichier, mais depuis une autre machine, que je dédie à tout ce qui comporte un risque, aussi minime fût-il.  Moyennant quoi, je suis toujours certain de ne jamais finir par polluer les autres moi-même, d'une manière ou de l'autre et à mon insu . 


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

Bon,
je viens de voir que chr(0) n'est pas forcément un choix heureux (différence de comportement d'une machine à l'autre)
Dans le code que je t'ai donné (celui du test de copie):
modifie donc cette ligne
feuille.Range("A" & Rows.Count).Value = chr(0)
par
feuille.Range("A" & Rows.Count).Value = "rien a cirer"
fais pour l'instant ton test en affichant les titres de lignes et colonnes (pour faciliter le test)
Si résultat enfin bon ===>> dis-le et j'appliquerai autre chose pour la sélection de ligne entière.
on va peut-être éviter (tu vas voir) de passer par une mise à disposition de ton classeur.
Dis-moi.
____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

et dis-moi avec précision :
- de quelle feuille (nom) vers quelle feuille (nom) veux tu copier tes sélections de lignes entières ?
- sur quelle feuille est ton fameux WorkSheetChange et quand doit-il intervenir (avant ou après la copie ?)
- quel est la raison fondamentale (autre qu'un "mécanisme d'inhibition", que je remplacerai) de la valeur de test  Sheets("Data").Range("AS12").Value ?
Si tu sais être TRES PRECIS et concis sur ces points ===>> c'est moi-même qui mettrai entre tes mains le classeur de base, tout prêt à l'emploi en ce qui concerne ces points.
Je te demande une seule chose : précision et concision (les tenants et aboutissants techniques, sans autres explications qui, chez moi, sont de nature à plutôt embrouiller les choses pour rien).
Bonne nuit et à demain.



____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

AHHH!

Bien vu avec Chr(0)!

Cette fois-ci, ça roule.

Bon, maintenant, il faut que travaille à adapter ça à mon besoin global que j'ai indiqué dans mon dernier message. :
Un clic sur une ligne = Sélection (1ère cellule en Rouge + gras)
Si ligne recliquée= Désélection (1ère cellule repasse en standard)
Quand la sélection est terminée (au moins une) =Bouton Exporter actif
Clic sur bouton Exporter = Lance la macro d'export

Chaque ligne de même row de chacune des 8 feuilles Archive est recopiée dans un classeur de 8 feuilles de même nom, créé par la macro, puis enregistré automatiquement selon un chemin fixe, avec un nom construit à partir des données de certaines cellules de la ligne.

Je ne sais pas trop par quel bout je vais attaquer ça avec TA méthode...
Tout est déja OK avec la mienne, mais j'aimerais bien y arriver de façon plus "Pro". 
Je suis bien plus à l'aise avec des calculs que des formats ou des traitements de lignes ou de fichiers.

Il me restera encore ce  problème avec Change, sur lequel je sèche toujours! 
Dans l'autre post, je vais décrire dans le détail ce que je veux obtenir afin d'ouvrir les pistes (avant de mettre mon fichier à dispo "pour tous", ce que je ne souhaite pas trop).

Cordialement
Rataxes64

CerberusPau · Answer

Bon, j'ai mis trop de temps à répondre et je viens de voir ton dernier message.

Ce dernier fait allusion au deuxième problème (W_Change qui est dans la feuille Général)

On risque de se mélanger avec l'objet de ce post (W_SelectionChange qui est dans la feuille Archive.
Raison pour laquelle j'ai fait un autre post dédié à W_Change.

Pour te répondre ici.
Le besoin est le suivant : 
Quand on fait un choix dans une cellule en liste (plage), on doit déclencher (et afficher!) les paramètres par défaut liés au choix fait. Par la suite, une fois le choix fait et les paramètres par défaut affichés, on doit pouvoir les modifier, et certaines de ces modifications induisent à leur tour des modifications....
Pour être plus clair, un exemple chiffré.

Etape0: Avec choix liste Agent E48Azote> K50=OUI (par défaut) donc K48=Q (formule) => R38=100 (par défaut)

 Etape1:  Modification K50 =NON (liste OUI;NON) donc K48= + (formule) et R38=10
Note: Si Retour K50 OUI = retour valeurs Etape0

 Etape2 : Modification Agent E48 =CO2 = > K50=OUI (par défaut) donc K48=,  (formule) => R38=90 (par défaut)

 Etape3:  Modification R38 =75 => E48 et K50 inchangés

Il est donc nécessaire de "Bloquer" W_Change dans la feuille Général dans certains cas, d'où AS12 dans la feuille Data.

Est-ce plus clair ?

Cordialement
Rataxes64

ucfoutu · Answer

pas vraiment clair, comme mécanisme. Je devine, mais à peine. serait-ce tout bêtement ceci ? Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("E48")) Is Nothing Then Application.EnableEvents = false '<<=================== avant tes modifs If Sheets("Général").Range("K48").Value "+" Then Sheets("Général").Range("R38").Value 10 If Sheets("Général").Range("K48").Value "Q" Then Sheets("Général").Range("R38").Value 100 If Sheets("Général").Range("K48").Value "," Then Sheets("Général").Range("R38").Value 90 Sheets("Général").Range("K50").Value = "OUI" ....... Application.EnableEvents = True '<<<<<<================= quand modifs finies ____________________ Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs. Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Bonjour,

J'avais déjà essayé ça, sans succès...

Ce que je ne pige pas, c'est que le script "de base" qui fonctionne très bien dans un nouveau classeur ouvert SEUL, ne fonctionne plus si j'ouvre (et seulement ouvre!) mon application, sauf à SAISIR la valeur changée, au lieu de simplement la choisir dans la liste déroulante de la cellule concernée!!!

Pour le moment, je voudrais laisser ce problème de côté. Je le reprendrai dans l'autre post ; ça sera peut être d'ailleurs plus utile pour les Forumeurs.

Je voudrais d'abord finaliser ici mon script d'Exportation d'Archive "complet", en ne passant plus du tout par ce (mauvais) principe (même s'il fonctionne) de mes cellules "relais" grâce à ta méthode.

Mais il faut encore qu'elle permette qu'une (ou plusieurs) des selections faites puisse être annulée (re-clic) pour donc récupérer la(les) valeur(s) Row de la sélection finale afin de lancer les recopies ligne par ligne (chaque ligne exportée "génèrant" en fait un fichier .xls)

Sans vouloir abuser, peux-tu (encore!) m'aider sur ce point ?
Je dois partir à 14h ce jour et ne pourrai me reconnecter que Jeudi prochain en fin dde journée. Mais bien sûr, entre temps, je vais "turbiner" de mon côté.

Cordialement
Rataxes64

ucfoutu · Answer

Mais il faut encore qu'elle permette qu'une (ou plusieurs) des selections faites puisse être annulée (re-clic) pour donc récupérer la(les) valeur(s) Row de la sélection finale afin de lancer les recopies ligne par ligne (chaque ligne exportée "génèrant" en fait un fichier .xls)
Sans vouloir abuser, peux-tu (encore!) m'aider sur ce point ? 

Je veux bien, mais il faut que tu m'exposes très clairement les choses, de manière technique :
- dans quelles circonstances, cette annulation ? A quel moment précis ?
- ne crois-tu pas qu'il suffit que l'utilisateur qui se serait trompé recommence sa sélection sans cliquer sur le bouton de copie ? On peut toujours, au besoin, lui afficher une boîte de dialogue lui montrant les aires qui vont être copiées s'il continue et attendre qu'il confirme ou infirme.

Je te rappelle que mon code ne modifie rien des couleurs des lignes sélectionnées tant que le bouton de copie n'a pas été cliqué.

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Voila le "cahier des charges" que j'ai :

Dans une feuille protégée et seule visible, "Archives", l'utilisateur clique sur une cellule quelconque d'un ligne, ce qui provoque la mise en gras et rouge du texte dans la première cellule de la ligne.
S'il reclique sur cette ligne, la première cellule repasse au format standard.
L'utilisateur doit pouvoir évidemment , avec le mêmes conséquences, faire une sélection 'continue", avec un clic + glisser.
Toutes les lignes dont le texte de la première cellule est Rouge + gras forment une "Sélection", qui sera "Exportée", ligne par ligne après action sur un bouton "Exporter".

La feuille Archives" peut contenir un TRES grand nombre de lignes, donc, l'utilisation d'une boucle For/next est à proscrire
L'Exportation proprement dite, consiste à créer un fichier .xls contenant une SEULE des lignes sélectionnées, et dont le nom.xls est composé à partir de certaines valeurs dans la ligne.
Si donc la sélection comporte 20 lignes, l'Exportation génèrera 20 fichiers contenant chacun la copie d'une des 20 lignes . La destination de ces fichiers est toujours dans un même répertoire dédié, et fixe (par exemple C:\InfiltroPass\Archives).

Détail important: une Archive est TOUJOURS composée des données d'une même valeur de Row sur 8 feuilles : 1°) Archives, 2°) Arch (2), juqu'à Arch (8). Le fichier d'Exportation comprend donc aussi 8 feuilles (de même nom), reprenant en ligne 1 de chacune de ses 8 feuilles, les valeurs d'un même Row de chacune des 8 feuilles Source.

J'ai fait un truc qui marche, mais très "lourd", en passant par des cellules relais, des tris et des copie multiples. Certs j'obtiens ce qu'il faut, mais il y a certainement moyen de faire mieux!

Cordialement
Rataxes64

CerberusPau · Answer

Voici ce que j'ai fait. Dans la feuille AchivesPrivate Sub Worksheet_SelectionChange(ByVal Target As Range) 'Marquage de la sélection pour Exportations Multiples 'Validation (texte bouton TestAction différent de IMPORTER, aucune sélection en cours : sinon Exit) If Sheets("Archives").TestAction.Caption = "IMPORTER" _ Or Sheets("Data").Range("AS15").Value = 1 _ Then Exit Sub 'Sélection de la ligne d'Archive à Exporter (première cellule non vide, et au delà de la ligne 3: sinon Msg et Exit) If ActiveCell.Value = "" Or ActiveCell.Row <= 3 Then MsgBox "Veuillez Sélectionnez un Test valide", vbExclamation, "Validation" Exit Sub End If 'On y va! Sheets("Archives").Unprotect 'Pour EXPORTER une ou plusieurs Archives If Sheets("Archives").TestAction.Caption = "EXPORTER" Then For Each cell In Selection If Sheets("Archives").Range("A" & cell.Row).Font.ColorIndex <> 3 Then Sheets("Archives").Range("A" & cell.Row).Font.Bold = True Sheets("Archives").Range("A" & cell.Row).Font.ColorIndex = 3 'Reprise de l'info Row d'une sélection Sheets("Archives").Range("IT" & cell.Row).Value = cell.Row Else Sheets("Archives").Range("A" & cell.Row).Font.Bold = False Sheets("Archives").Range("A" & cell.Row).Font.ColorIndex = 0 Sheets("Archives").Range("IT" & cell.Row).Value = "" End If Next 'Pour EXTRAIRE une (et toujours une seule!) Archive Else Sheets("Archives").Range("A4:A" & Sheets("Archives").Range("A65536").End(xlUp).Row).Font.Bold = False Sheets("Archives").Range("A4:A" & Sheets("Archives").Range("A65536").End(xlUp).Row).Font.ColorIndex = 0 Sheets("Archives").Range("A" & ActiveCell.Row).Font.Bold = True Sheets("Archives").Range("A" & ActiveCell.Row).Font.ColorIndex = 3 End If Sheets("Archives").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowSorting:=True End Sub Private Sub TestAction_Click() 'Bouton de traitement 'Supprimer If TestAction.Caption = "SUPPRIMER TEST" Then 'Suppression d'une et une seule Archive SupArchive 'Extraire un Test (données + mesures) ElseIf TestAction.Caption = "EXTRAIRE TEST" Then 'Extraction d'une et une seule Archive (Toutes les données) ExtraireTest 'Extraire un Site (données seulement) ElseIf TestAction.Caption = "EXTRAIRE SITE" Then 'Extraction d'une et une seule Archive (uniquement les données d'identification du Site) ExtraireSite ' Else 'Importation ou Exportation d'Archives VersArchives End If End Su Dans le module ArchivesSub VersArchives() Application.ScreenUpdating = False Fichier = ThisWorkbook.Name Application.DisplayFormulaBar = False 'IMPORTER 'If Sheets("Archives").TestAction.Caption "IMPORTER" Then LoadFichier 'EXPORTER 'ElseIf Sheets("Archives").TestAction.Caption "EXPORTER" Then Last = Sheets("Archives").Range("IT65536").End(xlUp).Row If Last = 2 Then Exit Sub Sheets("Data").Range("AS15").Value = 1 Sheets("Archives").Range("IT4:IT" & Last).Sort Key1:=Range("IT4"), Order1:=xlAscending 'Sélection de la ligne d'Archive à Exporter (première cellule non vide, et au delà de la ligne 3) If ActiveCell.Value = "" Or ActiveCell.Row <= 3 _ Then MsgBox "Veuillez Sélectionnez un Test valide", vbExclamation, "Validation": Exit Sub 'Extraction Nom Archive depuis feuille "Archives" Last = Sheets("Archives").Range("IT65536").End(xlUp).Row For K = 4 To Last rw = Range("IT" & K).Value NomArch = _ Sheets("Archives").Range("B" & rw).Value & "$" & _ Sheets("Archives").Range("C" & rw).Value & "$" & _ Sheets("Archives").Range("D" & rw).Value & "$" & _ Sheets("Archives").Range("E" & rw).Value & "$" & _ Sheets("Archives").Range("IV" & rw).Value 'Le fichier existe déjà ? FileExist = Dir("C:\InfiltroPass\Archives" & NomArch & ".xls") If FileExist <> "" Then 'Message d'alerte Msg = "Le fichier " & NomArch & " existe déjà" & vbNewLine & _ "Voulez-vous le remplacer ?" Style = vbYesNo + vbCritical + vbDefaultButton2 Title = "Gestion des Archives" Response = MsgBox(Msg, Style, Title) If Response = vbYes Then Kill ("C:\InfiltroPass\Archives" & NomArch & ".xls") Else 'Exit Sub GoTo Line1 End If End If 'Création du Fichier Excel "NomArch" dans C:\InfiltroPass\Archives Workbooks.Add Application.DisplayAlerts = False For i = Sheets.Count To 2 Step -1 Sheets(i).Delete Next i Application.DisplayAlerts = True Sheets(1).Name = "Archives" For i = 2 To 8 Sheets.Add.Move After:=Sheets(i - 1) Sheets(i).Name = "Arch(" & i & ")" Next i Sheets("Archives").Select ChDir "C:\InfiltroPass\Archives" ActiveWorkbook.SaveAs Filename:="C:\InfiltroPass\Archives" & NomArch & ".xls" Windows(Fichier).Activate ActiveSheet.Unprotect ActiveWindow.DisplayHeadings = True 'Recopies les valeurs de mesure du premier Ventilateur Rows(rw).Select Selection.Copy Windows(NomArch & ".xls").Activate Rows("1:1").Select ActiveSheet.Paste Application.CutCopyMode = False Cells.Columns.AutoFit Cells.EntireRow.Hidden = False Range("A1").ClearContents Range("A1").Select 'Recopies identiques pour les valeurs de mesure des ventilateurs supplémentaires For w = 2 To 8 Windows(Fichier).Activate If Sheets("Arch (" & w & ")").Range("B" & rw) = 0 _ Or Sheets("Arch (" & w & ")").Range("B" & rw) = "" _ Then Exit For Sheets("Arch (" & w & ")").Unprotect Sheets("Arch (" & w & ")").Rows("" & rw & ":" & rw & "").Copy Windows(NomArch & ".xls").Activate Sheets(w).Select ActiveSheet.Paste Application.CutCopyMode = False Cells.Columns.AutoFit Cells.EntireRow.Hidden = False Range("A1").ClearContents Range("A1").Select Next w 'Sauve et ferme Workbooks(NomArch & ".xls").Save Workbooks(NomArch & ".xls").Close Line1: Next K 'Retour à Archives Windows(Fichier).Activate Sheets("Data").Range("AS15").Value = 0 Sheets("Archives").Range("IT4:IT" & Last).ClearContents Last = Sheets("Archives").Range("A65536").End(xlUp).Row Sheets("Archives").Unprotect Sheets("Archives").Range("A4:A" & Last).Font.Bold = False Sheets("Archives").Range("A4:A" & Last).Font.ColorIndex = 0 ActiveWindow.DisplayHeadings = False Sheets("Archives").Range("A" & Range("A65536").End(xlUp).Row + 1).Select Sheets("Data").Range("AS15").Value = 0 Sheets("Archives").Protect _ DrawingObjects:=True, _ Contents:=True, _ Scenarios:=True, _ AllowFiltering:=True End If End Sub Note: Il ya bien sûr d'autres Sub et Form associées pour les changements du texte du bouton TestAction présent dans la feuille Archive. J'ai un peu peur des tes comentaires à venir! Merci d'y aller "en douceur". A jeudi Cordialement Rataxes64

ucfoutu · Answer

J'irai en douceur, ne t'inquiète pas !
et ce d'autant qu'il est fort vraisemblable que j'aborderai la démarche autrement.
Un point de ton cahier des charges reste cependant à préciser :
Dans une feuille protégée et seule visible, "Archives", l'utilisateur clique sur une cellule quelconque d'un ligne, ce qui provoque la mise en gras et rouge du texte dans la première cellule de la ligne.
S'il reclique sur cette ligne, la première cellule repasse au format standard.
L'utilisateur doit pouvoir évidemment , avec le mêmes conséquences, faire une sélection 'continue", avec un clic + glisser.
Toutes les lignes dont le texte de la première cellule est Rouge + gras forment une "Sélection", qui sera "Exportée", ligne par ligne après action sur un bouton "Exporter".
Quid des lignes de la première colonne, une fois l'exportation décidée ?
- doivent-elles repasser en style "normal" ou rester ainsi ?
- quid si deuxième sélection ? doit-elle éviter ou non si restées en l'état, les lignes déjà rouges ?  car si revenues à leur état "normal" )===>> risque évident de resélectionner ==>> envoyer ===>> ce qui a déjà été envoyé !
- quid, enfin, de ce qui doit se passer entre deux sessions ? On garde ou non les "rouges" ?

Voilà voilà (avant de m'y mettre) les questions qui, se posant, mettent en évidence certaines carences d'imprécision du cahier des charges lui-même !

Essaye de répondre à cela avant de partir jusqu'à jeudi, s'il te plait.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

1°) OUI , après un clic sur EXPORTER (et également QUITTER que je n'ai pas mentionné) , tout revient en standard (plus aucune sélection).

2°) OUI, Si une ligne sélectionnée (Texte 1ère cellule en rouge Gras) est "reprise", soit par un autre clic, soit dans la zone définie par un Clic + glisser, elle est de facto désélectionnée.

3°) OUI, à la fermeture de la session, comme d'alleurs à son ouverture, les Private Sub dans ThisWorkbook Private Sub Workbook_Open() et Private Sub Workbook_BeforeClose(Cancel As Boolean)assurent un Reset complet, feuille Archive comprise.

4°) De toute façon, la feuille Archive est uniquement "ouverte" par une macro depuis un bouton dans la feuille Général qui assure aussi un Reset au standard à l'affichage de Archives.

Ta réflexion est très pointue! 
Mon appli est assez complexe, et en ne voulant pas risquer d'embrouiller les choses, il peut s'avérer que des infos que je n'ai pas pensé utile de donner soient en fait importatntes. J'espère qu'il ne t'en manque plus.

Je pars dans une heure ; mais ne te sens pas obligé!

Cordialement
Rataxes64

CerberusPau · Answer

Autre chose

Souhaites-tu que je te mette à disposition mon fichier en t'envoyant un lien en MP ?

Rataxes64

ucfoutu · Answer

Bon.
Tu reviens demain et j'avais failli l'oublier.
Ton cahier des charges est très différent de ce qui avait été exposé au départ (et que, soit dit en passant, je préférais de beaucoup, mais si c'est le cahier des charges qu'on t'impose, je ne vais pas le discuter).

J'aime toutefois autant, pour ne pas avoir à chaque fois tout recommencer à zéro sur des bases différentes, que l'on se mette bien d'accord sur chaque étape (et qu'une fois accord, on n'y revienne plus !)
Voilà donc l'étape du seul mécanisme de sélections.

Essaye-la sur un classeur tout neuf, avec quelques données

Sur la feuille Feuil1, tu insères un bouton de commande Commandbutton1, avec sa propriété Caption = "Préparer sélections"

et ce code :

Option Explicit
Private sele As Range, corr As Range, prepare As Boolean
Private Sub CommandButton1_Click()
  If CommandButton1.Caption = "Préparer sélections" Then
    CommandButton1.Caption = "terminer sélections"
    prepare = True
  Else
    CommandButton1.Caption = "Préparer sélections"
    prepare = False
  End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 If prepare Then
   If sele Is Nothing Then ajout Target: Exit Sub
   If Intersect(Target, sele) Is Nothing Then ajout Target: Exit Sub
   If Not Intersect(Target, sele) Is Nothing Then
     Dim r As Range
     For Each r In Target.Rows
       If Intersect(r, sele) Is Nothing Then
         ajout r
       Else
         enleve r
       End If
     Next
   End If
 End If
End Sub

Private Sub ajout(t As Range)
  Dim r As Range
  For Each r In t.Rows
    Range("A" & r.Row).Interior.Color = vbRed
    r.EntireRow.Font.Bold = True
    If sele Is Nothing Then
       Set sele = r.EntireRow
     Else
       Set sele = Union(sele, r.EntireRow)
     End If
  Next
End Sub

Private Sub enleve(t As Range)
   Set corr = Nothing
   Dim r As Range
   For Each r In sele.Rows
     If Intersect(t, r) Is Nothing Then
       If corr Is Nothing Then
         Set corr = r
       Else
         Set corr = Union(corr, r)
       End If
     Else
       Range("A" & r.Row).Interior.ColorIndex = xlNone
       r.EntireRow.Font.Bold = False
     End If
   Next
   If Not corr Is Nothing Then Set sele = corr
End Sub

tu lances ===>> regarde la différence quand bouton non encore cliqué et quand bouton cliqué ===> tu comprendras vite
Je suis allé encore un peu plus loin que toi : si l'utilisateur revient sur une sélection déjà faite et continue par glisser, la sélection déjà faite est annulée et les autres ajoutées (tu me payes combien pour ce petit bonus ?).
Voilà.
Essaye et dis-moi ===>> on passera alors aux deux autres étape (sans jamais plus revenir sur celle-ci).





____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

Mais, maintenant que ce travail liminaire est (du moins à mon avis) fait (de sorte à ne pas me retrancher derrière des excuses) ====>>

Je vais te confesser (pour le cas où tu ne t'en serais pas rendu compte) que j'aurais aussi bien pu choisir "Satan" (le diable, tu sais) comme pseudo 

Satan, donc, va "préparer le terrain" de la démolition du cahier des charges, tel que conçu par ton client (et j'espère pour lui qu'il comprendra l'intérêt de reconsidérer avec un soupçon d'intelligence ce que j'avais proposé d'emblée, code inclus) ==>> on met donc en regard :

1) une partie du cachier des charges
Dans une feuille protégée et seule visible, "Archives", l'utilisateur clique sur une cellule quelconque d'un ligne, ce qui provoque la mise en gras et rouge du texte dans la première cellule de la ligne.
S'il reclique sur cette ligne, la première cellule repasse au format standard.
L'utilisateur doit pouvoir évidemment , avec le mêmes conséquences, faire une sélection 'continue", avec un clic + glisser. 
2) quelques réactions et précisions (de toi) :
Un clic sur une ligne = Sélection (1ère cellule en Rouge + gras)
Si ligne recliquée= Désélection (1ère cellule repasse en standard) 

Ces raccourcis clavier ne sont pas toujours connus des utilisateurs Lamba.

Pour eux, un simple clic sur une ligne est quand même plus convivial, non? 

cette dernière réponse faisant réponse à ma proposition :
on se place dans la première cellule de la ligne et on appuie simultanément
CTRL, MAJ et flèhce droite 

Ah !

Tu vas maintenant demander au concepteur de ce "cahier des charges" si "bien pensé", ce qui arrivera, avec son mécanisme, le jour où (surtout si la souris ne marche plus), l'utilisateur utilise son clavier .... pour, de surcroît, tenter de sélectionner deux lignes non contigües. 

La "soluce", je suis également capable de la mettre en oeuvre, mais à quel prix ? ===>>> l'utilisateur devra apprendre d'autres gestes, pour y faire face. Et ces gestes-là seront bien plus complexes et contraignants, pour toi, à les leur enseigner et, pour eux, à les retenir, que 
on se place dans la première cellule de la ligne et on appuie simultanément
CTRL, MAJ et flèhce droite
gestes que tout utilisateur de Excel est censé connaître

Mais certains d'entre eux feront certains gestes au clavier même si leur souris fonctionne !

On va bien rigoler, tu vas voir 

Voila voilou ...
Te restera sans doute à persuader ton client de changer de tactique et de réfléchir sur celle que j'avais proposée (et codée) depuis le début. Et ensuite, ce sera comme dans la chanson "tu veux ou tu veux pas", mais il sera seul responsable de ses décisions.
Moi, j'ai fait les deux cas 

J'attends ton retour, donc ...



____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Voilà, je suis rentré.
J'attaque "Tout ça" (!) demain.

Cordialement
Rataxes64

ucfoutu · Answer

OK !
regarde déjà çà. et dis ....
Si tu confirmes que c'est ce que tu veux vraiment (après avoir tout lu et interrogé ton client) ===>> sache que j'ai déjà, entre-temps et pour m'amuser, fait du plus condensé pour le même résultat.
A demain.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Bien, d'abord merci pour ton implication !

J'ai donc construit un nouveau classeur selon tes instructions, à ceci près que j'y ai mis les formats .Font attendus (un détail), sans encore inclure les limites des lignes à traiter (pas les 2 premières, ni les vides).

Ton code me pose beaucoup de questions, car je suis loin d'avoir tes connaissances et ta maîtrise. 
Avant d'oser te demander des explications presque pas à pas, j'ai mis quelques MsgBox pour me "remonter" les plages traitées, et surtout la plage finale des lignes à copier. 

A l'ouverture du classeur
Pour prepare= True (On Ajoute)
Si on ne sélectionne qu'une ligne par clic (une ou plusieurs)  corr  reste vide ; mais si on sélectionne en plus par clic+glisser, alors corr donne bien la plage sélectionnée.
De même, si on sélectionne directement plusieurs ligne par clic+glisser, corr donne la plae sélectionnée ; mais si on sélectionne une ligne en plus par un clic (une ou plusieurs) corr redevient vide.
Cela ne se produit pas pour prepare =False(On enlève).

Dans le classeur ouvert 
Après une ou plusieurs action sur le bouton; il semble que  sele "garde quelque chose en mémoire". On ve "voit" rien (pas de mise en gras et rouge ),  mais ça fausse le résultat final de corr

Où placer un éventuel Set sele =   Nothing ???

Par ailleurs, bien sûr qu'il faut obtenir :si l'utilisateur revient sur une sélection déjà faite et continue par glisser, la sélection déjà faite est annulée et les autres ajoutées  
Dans mon Cahier des Charges :L'utilisateur doit pouvoir évidemment ,  avec le mêmes conséquences , faire une sélection "continue", avec un clic + glisser.

Dans mon "brouillon" :'Pour EXPORTER une ou plusieurs Archives
    If Sheets("Archives").TestAction.Caption  = "EXPORTER" Then
        For Each cell In Selection
        '=========================
            If Sheets("Archives").Range("A" & cell.Row).Font.ColorIndex <> 3 Then
                Sheets("Archives").Range("A" & cell.Row).Font.Bold = True
                Sheets("Archives").Range("A" & cell.Row).Font.ColorIndex = 3
                'Reprise de l'info Row d'une sélection
                Sheets("Archives").Range("IT" & cell.Row).Value = cell.Row
            Else
                Sheets("Archives").Range("A" & cell.Row).Font.Bold = False
                Sheets("Archives").Range("A" & cell.Row).Font.ColorIndex = 0
                Sheets("Archives").Range("IT" & cell.Row).Value = ""
            End If
        Next
 

Je sais bien que je n'ai pas "tout indiqué" en tête de mon post, non seulement pour qu'il soit bien clair, mais aussi car je pensais n'avoir besoin d'un coup de main que pour ce point :
'Reprise des lignes sélectionnées
    Range("4:4,6:6,8:8").Select
sans entrer dans le détail des formats et annulation de sélection (je pensais pouvoir faire tout seul: voir mon "brouillon final"). 
Je ne me doutais pas de la dimension du "champ" de cette question. 

 En résumé:  Ton code me convient car ENFIN je peux me passer de mes "cellules relais" (facilité à mon niveau pour "récupérer" les rows de la sélection, et traiter les formats et annumlations) ; mais comment récupérer la sélection pour la copie ?
 Ci-dessous, ton code avec mes modifs de formats et les MsgBoxOption Explicit
Private sele As Range, corr As Range, prepare As Boolean

Private Sub CommandButton1_Click()

    If CommandButton1.Caption  = "Préparer sélections" Then
        CommandButton1.Caption = "terminer sélections"
        prepare = True
    Else
        CommandButton1.Caption = "Préparer sélections"
        prepare = False
    End If
  
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If prepare Then
        If sele Is Nothing Then ajout Target: Exit Sub
        If Intersect(Target, sele) Is Nothing Then ajout Target: Exit Sub
        If Not Intersect(Target, sele) Is Nothing Then
            Dim r As Range
            For Each r In Target.Rows
                If Intersect(r, sele) Is Nothing Then
                    ajout r
                Else
                    enleve r
                End If
            Next
        End If
    End If
 
End Sub

Private Sub ajout(t As Range)

    Dim r As Range
                'rajout pour MsgBox
                Dim ra As String, rs As String, rt As String
    For Each r In t.Rows
                'rajout pour MsgBox
                If ra "" Then ra "Aucun" Else ra = r.Address
                If rt "" Then rt "Aucun" Else rt = t.Address
        Range("A" & r.Row).Font.ColorIndex = 3
        Range("A" & r.Row).Font.Bold = True
        If sele Is Nothing Then
            Set sele = r.EntireRow
        Else
            Set sele = Union(sele, r.EntireRow)
        End If
                'rajout pour MsgBox
                If rs "" Then rs "Aucun" Else rs = sele.Address
                MsgBox "Ajoute" & vbNewLine & _
                "row    " & ra & vbNewLine & _
                "sele " & rs & vbNewLine & _
                "t        " & rt & vbNewLine
        
    Next
                'Plage sélectionnée ?
                MsgBox "Corr = " & rs

End Sub

Private Sub enleve(t As Range)

    Set corr = Nothing
    Dim r As Range
                'rajout pour MsgBox
                Dim ra As String, rs As String, rt As String, rc As String
                If rt "" Then rt "Aucun" Else rt = t.Address
    For Each r In sele.Rows
                'rajout pour MsgBox
                If ra "" Then ra "Aucun" Else ra = r.Address
                If rs "" Then rs "Aucun" Else rs = sele.Address
        If Intersect(t, r) Is Nothing Then
            If corr Is Nothing Then
                Set corr = r
            Else
                Set corr = Union(corr, r)
            End If
        Else
            Range("A" & r.Row).Font.ColorIndex = 0
            Range("A" & r.Row).EntireRow.Font.Bold = False
        End If
                'rajout pour MsgBox
                If rc "" Then rc "Aucun" Else rc = corr.Address
                MsgBox "Enlève" & vbNewLine & _
                "row    " & ra & vbNewLine & _
                "sele " & rs & vbNewLine & _
                "t          " & rt & vbNewLine & _
                "corr " & rc
    
    Next
    If Not corr Is Nothing Then Set sele = corr
                'Plage sélectionnée ?
                MsgBox "Corr = " & rc
  

End Sub


Cordialement
Rataxes64

ucfoutu · Answer

Ouais... Je vois bien que tu n'as pas bien compris le code. la variable prepare est une variable booléenne. Elle change d'état en fonction du clic sur le bouton. Quand elle est à true, le mécanisme de sélection est engagé. Il se désengage quand à False Lorsque le mécanisme est engagé, il l'est, non seulement pour ajouter, mais également pour traiter La variable de range corr est là pour rétablir la variable de range sele, en cas de sélection de lignes déjà dans sele. Elle est vide au départ de toute nouvelle sélection. Elle vérifie que la sélection (target, donc) n'est pas déjà contenue dans sele. Si oui : elle reste ce qu'elle est. Si non, elle se rajoute target. Elle termine en sustituant son contenu à celyui de sele ===>> et sele se trouve donc "débarrassé" du superflu. Si tu veux "voir" ce que contient sele ===>> ajoute cette msgbox : ... .... Else CommandButton1.Caption = "Préparer sélections" prepare = False msgbox sele.address ' <<<<======= c'est ici que tu le verras End If .... la variable sele continue à l'incrémenter, y compris entre deux cycles de sélections, ce qui permet d'arrrêter, de voir, de reprendre, etc ... Je n'ai encore, à ce stade rien fait pour la vider et tout reprendre à z&éro. Cett(e partie est ultra-facile à faire et on le verra plus tard. On n'en est, à ce stade, qu'à décider une fois pour toutes du SEUL MECANISME des sélections. Confirme-moi que tu acceptes ce mécanisme et je t'en envoie un second, plus simple encore, qui fait la même chose. Ce n'est qu'ENSUITE (après cette décision totalement ARRETEE, que l'on passera aux autres étapes. Laisse donc pour l'instant (ne te jette pas la tête en avant) tomber toutes les questions relatives à ce que nous allons en faire (et comment nous allons le faire) ensuite (çà, je le sais déjà, quel que soient tes choix possibles) Pour résumer : On SERIE les problèmes et on n'en traite QU'UN A LA FOIS ____________________ Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs. Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

Tiens regarde cette manière-là, très différente de la première :
fais-le sur un classeur neuf, avec le même bouton que précédemment :
Option Explicit
Private sele As String, prepare As Boolean
Private Sub CommandButton1_Click()
  If CommandButton1.Caption = "Préparer sélections" Then
    CommandButton1.Caption = "terminer sélections"
    prepare = True
  Else
    CommandButton1.Caption = "Préparer sélections"
    prepare = False
    Dim decision As Integer
    decision = MsgBox("voilà les lignes actuellement contenues dans sele : " & vbCrLf & Replace(sele, "@", " ") & vbCrLf & _
    "voulez-vous continuer (oui garder la sélection et continuer à sélectionner - non tout effacer et reprendre à zéro)", vbYesNo)
    If decision = vbNo Then
      Dim e
      For Each e In Split(sele, "@")
        If e <> "" Then
          Range("A" & e).Interior.Color = xlNone
          Range("A" & e).EntireRow.Font.Bold = False
          sele = ""
        End If
      Next
    End If
  End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If prepare Then traitons Target
End Sub

Private Sub traitons(t As Range)
  Dim r As Range, tut As String
  For Each r In t.Rows
    If sele "" Then tut "@" Else tut = ""
    Select Case Range("A" & r.Row).Interior.Color
      Case vbRed
        Range("A" & r.Row).Interior.Color = xlNone
        r.EntireRow.Font.Bold = False
        sele = Replace(sele, "@" & r.Row, "")
      Case Else
        Range("A" & r.Row).Interior.Color = vbRed
        r.EntireRow.Font.Bold = True
        sele = sele & tut & r.Row & "@"
     End Select
  Next
  CommandButton1.Top = Cells(Mid(t.AddressLocal, InStrRev(t.AddressLocal, "$") + 1), t.Column).Top
  CommandButton1.Left = Cells(t.Row, t.Column + t.Columns.Count).Left
End Sub

Je t'y ai ajouté, pour te tranquilliser une msgbox qui, s'affichant quand clic sur "terminer", te montre des choses et te laisse un choix 
Mais c'est là de l'accessoire, que nous ne verrons qu'après. Je n'ai fait ce rajout que pour que tu cesses de te poser des questions sur ce qui va ensuite venir, hein !

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

Ah oui : j'y ai aussi rajouté un petit truc pour que le bouton de commande te suive partout, comme un toutou (plus pratique). 


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

OK,
ça s'éclaire un peu...

En fait, il n'y a pas (encore) de "Reset" sur sele, et, si je comprens bien, ce que je constate pour sele dans la MsgBox est donc "normal".
 
Pour être précis:
J'ouvre le classeur : Aucune cellule n'est sélectionnée.
J'active le bouton sur "Terminer"
Je sélectionne une cellule en ligne 3 =  > A3 passe en Gras Rouge.
Je sélectionne une cellule en ligne 4 => A4 passe en Gras Rouge.
Donc les lignes A3 et A4 feront partie de la sélection.

Je resélectionne une cellule en ligne 3 => A3 passe en standard.
Je resélectionne une cellule en ligne 4 => A4 passe en standard.
Donc il n'y plus de sélection à prendre en compte.

Du moins telle est la conclusion au vu de l'affichage en colonne A.

Si je clique le bouton pour repasser à "Préparer" la MsgBox me renvoie que  sele  à "gardé" l'info de la ligne 4... évidemment puisqu'une de ces cellules était sélectionnée!

Donc, pour répondre à ta question précise : 
OUI, le "moteur" de sélection est celui qui convient!

1°) Il faut y ajouter l'exclusion d'une sélection (prepare =True):
   > Dans les lignes de titre 1 et 2 (bien que dans l'appli elles soient verrouillées),
> Pour une sélection inopinée dans une ligne vide.
Exemple, dans  SelectionChange  sous prepare =true :If Not Intersect(Target, Rows(1)) Is Nothing Then Exit Sub
If Not Intersect(Target, Rows(2)) Is Nothing Then Exit Sub
If ActiveCell.Value =  "" Then Exit Sub

2°) Il faut un "Reset" complet pour (prepare=False):
   => Lorsque l'on va (ou après avoir) lancer la copie de la sélection.
   => Si l'on veut abandonner et quitter.
Exemple dans  Command_Button  sous prepare =False :Set sele =  Nothing

Il y quand même une ligne que je souhaiterais que tu me détailles :If Intersect(Target, sele) Is Nothing Then ajout Target: Exit Sub
Pourquoi ajout Target est-il nécessaire? ça  semble  fonctionner sans.

Pour travailler dans ton exemple, le bouton que tu as mis est plus qu'utile (!), mais dans l'application, c'est différent.
Il y est prévu 2 boutons :
"Exporter" pour lancer la copie de la sélection + RAZ + retour à une autre feuille "Général".
"Retour Général" pour annulation + RAZ + retour à une autre feuille "Général".

l'action  équivalente  à "Bouton  =Terminer" (Prepare= True) sera donc effectuée par le lancement de l'accès à la feuille "Archives", où doivent s'effectuer les choix,  grâce à un bouton ("Accéder aux mesures") depuis la feuille "Général".
L'action  équivalente  à Bouton =Préparer" (Prepare=False) sera donc effectuée par le lancement de la copie avec le bouton "Exporter", ou par l'action d'annuler et quitter avec le bouton "Retour au Général".

Cordialement
Rataxes64

CerberusPau · Answer

Ahhhh!
Je suis BEAUCOUP plus lent que toi!
Ma réponse ne concerne évidemment pas ce que tu viens de m'envoyer.
Excuses-moi de te ralentir, mais je détailles tout ce que tu fais, et quand je ne comprends pas bien, je chercxhe avant de te poser une question quand il m'appartien d'abord de chercher moi-même la réponse.

Bon, je regade ce nouveau code!

Cordialement
Rataxes64

ucfoutu · Answer

Je te l'ai dit : un seul pas à la fois (et je ne veux traiter les autres et n'en entendre parler qu'ensuite, s'il te plait) ! Sinon, on s'y perd et s'y disperse inutilement à ce stade
As-tu essayé ma deuxième méthode ?
Essaye-la (mais ne me parle de rien d'autre que de ce qu'elle fait à ce seul stade, hein).
J'insiste : il es indispensable de ne pas se projeter sur le reste, mais de bien arrêter (et définitivement), cette seule étape d'abord.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Autre chose.

L'action "Exporter" est particulière dans l'appli.

Il s'agit TRES OCCASIONNELLEMENT de pouvoir exporter (sous la forme d'un fichier) chaque même ligne contenue dans les feuilles Archives à Arch(8). 
Cela à destination d'un autre utilisateur avec une autre appli, qu'il va pouvoir Importer dans ses propres feuilles Archive à Arch(8).

Dans la feuille Général, il y a un bouton dédié à cette action qui lance une form avec 2 boutons EXPORTER ARCHIVE et IMPORTER ARCHIVE.
A l'action du bouton EXPORTER ARCHIVE, la feuille Archives s'ouvre (Général masquée) et par défaut, il n'y a aucune séletion. L'utilisateur fait sa sélection comme indiquée (clic ou clic+glisser, avec annulation au deuxième clic ET d'un autre clic+glisser sur une ligne déjà sélectionnée), puis il clique sur le bouton EXPORTER dans la feuille Achives.
A tout moment, il peut annuler et quiter en cliquaznt ssur Retour au Général. 

La RAZ de la sélection doit alors être activée.

Je ne l'ai pas dit, mais les fichiers exportés sont rangés dans un répertoire dédié (C:\Archives), prêts à être transmis ou prélevés. Donc, bien sûr, il n'est pas question d'y faire des doublons... En cas de doublon, la macro Exporter propose d'écraser ou annuler le fichier concerné, avant de poursuivre.


Cordialement
Rataxes64

CerberusPau · Answer

OK.

Donc, on "oublie", et on passe à ton dernier jet 
Je crée le nouveau clsseur et te tiens au jus.

Cordialement
Rataxes64

CerberusPau · Answer

C'est fait,

Tout va bien (comme ton précédent code), mais si on répond Non dans la MsgBox, et qu'on sélectionne une lignes de la sélection  annulée, il semble y avoir encore un truc qui cloche

Exemple avec une seule ligne (7)
Ouverture du Classeur (bouton= Préparer, aucune sélection)
1) clic sur Préparer => Terminer
2) selection sur ligne 7 => format rouge 
3) clic sur Terminer => Préparer => MsgBox = ligne 7
4) réponse  NON     => format ligne 7 remis au standard
4) clic sur Préparer= > Terminer
5) selection sur ligne 7 =>  Pas de changement de format 
8) clic sur Terminer  => Préparer  => Ligne 7 pas indiquée dans MsgBox

Mais peut-être s'agit-il d'une autre étape à venir.

Cordialement
Rataxes64

CerberusPau · Answer

Juste une question:

Peut-on gérer prepare = True depuis un bouton sur une autre feuille ?

Cordialement
Rataxes64

ucfoutu · Answer

5) selection sur ligne 7 => Pas de changement de format
8) clic sur Terminer => Préparer = > Ligne 7 pas indiquée dans MsgBox 
C'est que tout simplement (et  la même chose avec l'autre code , hein) tu as cliqué sur la même cellule  ===>> pas d'évènement sélection_change, bien évidemment ! Et on ne pourra jamais rien contre cela, y compris si on force une sélection "ailleurs", car si l'utilisateur clique sur cet  "ailleurs" === >> pas d'évènement sélection_change non plus 
Tu viens de découvrir une autre des faiblesses du cahier des charges de ton client.
Il faudra apprendre à l'utilisateur, avec un tel cahier des charges :
1) à ne pas se servir de son clavier (ou alors oui (je saurais faire) mais  en apprenant encore d'autres gestes  !)
2) à ne pas utiliser la touche contrôle CTRL
3) à changer de cellule, sur la même ligne, s'il voit une absence de réaction

Je te l'avais dit et le répète : ce cahier des charges (supposé "faciliter" la vie de l'utilisateur) est invalidant. Je préférais de très loin ma toute première "vue" des choses et ma toute première (dès le début) approche et méthode.

Alors : on arrête maintenant quelle méthode, parmi les trois (y compris la toute première) proposées ? 

____________________
Réponse exacte ?  => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Oups, fin du message manquante

Dans feuille (2):Private Sub Exporter_Click()
Sheets(1).valide
End Sub
Dans feuille(1)
Sub valide()
prepare = True
End Subça marche, mais est-ce correct ?
Rataxes64

ucfoutu · Answer

Quant à :
Juste une question:

Peut-on gérer prepare =  True depuis un bouton sur une autre feuille ?


1) oui
2) je regrette que cette question vienne enfreindre la discipline que j'ai voulu installer (je ne veux entendre parler, à cette étape, que du mécanisme de cette étape)
Alors : quelle méthode est retenue des trois  pour ce seul mécanisme des sélections  ?

____________________
Réponse exacte ?  => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

ucfoutu · Answer

Si tu continues à te "projeter", à insister à le faire, je te laisse pile là !
Alors fais attention.
C'est dit clairement, j'espère.


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Bien.

On s'en tiens à ta méthode 2 sur laquelle j'ai de mon côté aussi avancé.

A savoir:

J'ai inclus dans la feuille 2 un bouton que j'ai dans  la feuille "Général" dans mon appli.

J'ai inclus dans la feuille 1 les 2 boutons que j'ai dans la feuille "Archives" de mon appli.

L'action sur le bouton feuille 2 sélectionne la feuille 1 et met prepare à True.

Les sélections dans la feuille 1 sont faites selon ta méthode 2 désormais retenue
Concernant le problème de la "reselection", je suis arrivé à le contourner et c'est OK.

Un des 2 bouton dans la feuille 1 permet de quitter et retourner dans la feuille 2 (avec RAZ de tout ce qui a été fait en feuille 1)

Le deuxième bouton dans la feuille 1 fait la même chose, mais doit rapatrier les N° de ligne sélectionnés pour pour être traités par ma macro d'exportation existante).

Comment récupérer ces valeurs une fois la sélection terminée ? Comme je te l(='ai dit, j'ai pensé (à tort) à corr ou sele, mais ça ne fonctionne pas si une sélection unique est faite.

Pour l'instant, j'ai essayé sans succès avec ce qu'il y a dans ton 3ème code où la MsgBox les donne.

En clair, on touche au but si je peux récupérer les N° de colonnes de la sélection terminée.


Cordialement
Rataxes64

ucfoutu · Answer

A demain (fatigué)
Et ne t'inquiète pas pour les lignes vides que l'utilisateur distrait pourrait sélectionner.
Tu verras demain pourquoi on peut s'en moquer comme de l'an 14 !

La méthode 2 ? Tu es sûr et certain ?
La 3 est beaucoup plus rapide !

Qu'est-ce qui te gêne, dans la 3 ? qu'elle ne contienne que des N°s de ligne ? Oui ! et alors ? ===>> on peut ensuite en faire une véritable bouchée de pain et dans la plus grande aisance !

Je lirai ta réponse demain.



____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Tu as raison, (et probablement toujours!), la méthode 3 est bien plus attractive.

Au risque dde me faire (encore) rouspéter, j'y ai mis mes mains sales, et tu vas probablement bondir, mais au moins je fais avec mes mains.
Voila ce que j'ai fait avec la métode 3, compatible avec mon appli. Toutefois, je vais moi aussi me reposer les méninges, et je verrai demain à l'y inclure pour voir si ma macro d'exportation tourne avec. 

A demain si tu n'est pas trop fâché de mes "expériences" avec ton code.

Feuille 1 :
Une liste sur 10 lignes et 5 colonnes
2 boutons Exporter et Quitter
La Private Sub Option Explicit
Private sele As String, prepare As Boolean, last

Private Sub Exporter_Click()
    prepare = False
    last = Range("A65536").End(xlUp).Row + 1
    Sheets(1).Cells(last, 1).Select
    Dim e
    For Each e In Split(sele, "@")
        If e <> "" Then
            Range("A" & e).Font.ColorIndex = 0
            Range("A" & e).Font.Bold = False
            
''Call ma macro d'exportation: row à prendre en compte e
    'exemple: relevé des valeurs en colonne A de feuille 2
    last = Sheets(2).Range("A65536").End(xlUp).Row + 1
    Sheets(2).Cells(last, 1).Value = e
'sele ""
        End If
    Next
    Sheets(2).Select
End Sub

Private Sub Quitter_Click()
    prepare = False
    Sheets(1).Columns(1).Font.Bold = False
    Sheets(1).Columns(1).Font.ColorIndex = 0
    last = Range("A65536").End(xlUp).Row + 1
    Sheets(1).Cells(last, 1).Select
    sele = ""
    Sheets(2).Select
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    'If Not Intersect(Target, Rows(1)) Is Nothing Then Exit Sub
    'If Not Intersect(Target, Rows(2)) Is Nothing Then Exit Sub
    If ActiveCell.Value = "" Then Exit Sub
    If prepare Then traitons Target
End Sub

Private Sub traitons(t As Range)
    Dim r As Range, tut As String
    For Each r In t.Rows
        If sele "" Then tut "@" Else tut = ""
        Select Case Range("A" & r.Row).Font.ColorIndex
            Case 3
                Range("A" & r.Row).Font.ColorIndex = 0
                Range("A" & r.Row).Font.Bold = False
                sele = Replace(sele, "@" & r.Row, "")
            Case Else
                Range("A" & r.Row).Font.ColorIndex = 3
                Range("A" & r.Row).Font.Bold = True
                sele = sele & tut & r.Row & "@"
        End Select
    Next
End Sub

Sub valide()
    prepare = True
End Sub


Feuille 2 :
Un bouton Exporter
la Private subPrivate Sub Exporter_Click()
    Sheets(1).valide
    Sheets(1).Select
End Sub

Voilà, je me suis mis en mode Zen, prêt à recevoir tes foudres, qui ont ceci de bien, c'est même en m'aveuglant souvent, elles m'éclairent toujours.

Cordialement
Rataxes64

CerberusPau · Answer

Oups!
J'ai oublé de décommenter les deux lignes ded titre: Il faut lire :
    If Not Intersect(Target, Rows(1)) Is Nothing Then Exit Sub
    If Not Intersect(Target, Rows(2)) Is Nothing Then Exit Sub

Rataxes64

ucfoutu · Answer

Pourquoi veux-tu que je te reproche celka ? 
Tant que tu restes focalisé sur cette étape ===>> va bene (et c'est ton appli).

Tiens ! pour te récompenser de cet effort de discipline ===>> voilà qui traite (non traite) d'emblée les lignes vides qui seraient maladroitement sélectionnées  (et on n'en parle plus).
Private Sub traitons(t As Range)
  Dim r As Range, tut As String
  Application.EnableEvents = False
  For Each r In t.Rows
       Dim yen_a As Range
        On Error Resume Next
        Set yen_a = Range("A" & r.Row & ":X" & r.Row).SpecialCells(xlCellTypeConstants)
        On Error GoTo 0
        If Not yen_a Is Nothing Then
          Set yen_a = Nothing
          If sele "" Then tut "@" Else tut = ""
          Select Case Range("A" & r.Row).Font.ColorIndex
            Case 3
                Range("A" & r.Row).Font.ColorIndex = 0
                Range("A" & r.Row).Font.Bold = False
                sele = Replace(sele, "@" & r.Row, "")
            Case Else
                Range("A" & r.Row).Font.ColorIndex = 3
                Range("A" & r.Row).Font.Bold = True
                sele = sele & tut & r.Row & "@"
        End Select
     End If
  Next
  Application.EnableEvents = True
End Sub



____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Merci!

J'intègre demain DANS mon appli et te tiens au courant.

Cordialement
Rataxes64

CerberusPau · Answer

J'ai pas pu résister...

J'ai entré ma "mixture" telle que je viens de te l'envoyer dans mon appli,

  ET TOUT MARCHE !


Reste à remplacer mon If ActiveCell.Value = "" Then Exit Sub
 
par tes lignes
       Dim yen_a As Range
        On Error Resume Next
        Set yen_a = Range("A" & r.Row & ":X" & r.Row).SpecialCells(xlCellTypeConstants)
        On Error GoTo 0
        If Not yen_a Is Nothing Then
          Set yen_a = Nothing

sans oublerApplication.EnableEvents = True
 

Un TRES long échange qui abouti "comme il faut".

Mais... il me reste à voir le problème avec W_Change, sur l'autre post, qui lui est resté "dans l'état".

Avant de cliquer sur Réponse acceptée, comme il se doit, tu as peut être "quelque chose" à ajouter, et j'attends donc ton aval.

 Merci encore


Cordialement
Rataxes64

ucfoutu · Answer

Très bien Juste 2 ou 3 petites modifs et rajouts 1) Private Sub Exporter_Click() prepare = true ' à la place de sheets(1).valide Sheets(1).Activate ' à la place de select (pour ne pas risquer de déclencher un "change" ' et utilise plutôt le nom de la feuille (sheets("nom_feuille"), ce qui te mettra à l'abri ' des conséquences d'un déplacement d'onglet End Sub 2) modifie Private Sub Exporter_Click() prepare = true ' à la place de Sheets(1).valide End Sub 3) supprime totalement cette procédure : Sub valide() prepare = True End Sub 4) tout en faut de ta feuil1 remplace : Option Explicit Private sele As String, prepare As Boolean, last par Option Explicit Private last as long 5) ajoute cette ligne Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.OnKey "{ESC}", "changeetat" '<<<<<<=========== Ajout If ActiveCell.Value = "" Then Exit Sub If prepare Then traitons Target End Sub 6) ajoute un module avec ce code : Public sele As String, prepare As Boolean Public Sub valide() prepare = True End Sub Public Sub changeetat() If ActiveSheet.Name <> "nom_feuille_où_sélections" Then Exit Sub ' <<<== 'remplace ce qu'il y a entre guillemets par le vrai nom de la feuille dédiée aux sélections prepare = Not prepare Dim mess As String If Not prepare Then MsgBox "vous venez de changer d'état et êtes maintenant en mode ""NORMAL""" & _ "dans ce mode, vous avez interrompu (sans la supprimer) temporairement la sélection " & vbCrLf & _ "Ce mode vous permet d'effectuer au besoin d'autre manoeuvres sans incidence sur la sélection" & _ "éventuellement en cours" & vbCrLf & vbCrLf & _ "N'oubliez pas, une fois terminées ces autres manoeuvres, de revenir au mode sélection " & _ "en pressant à nouveau la touche ESCAPE" Else MsgBox "Vous êtes de nouveau en mode ""SELECTION""" End If End Sub ATTENTION : ce sont les 6 modifs et ajouts qu'il te faut faire (tous) avant de tester Regarde ce qui se passe maintenant lorsque, te trouvant sur la feuille des sélections, tu appuies sur la touche ESCAPE (tu vas comprendre) Ceci n'enlève rien de ce qui existait, mais permet (notamment en cas de panne de souris), de pouvoir sélectionner deux lignes non contigües (ESCAPE ===>> on passe à la ligne voulue sans incidence sur sélection ====>> ESCAPE ===> on est à la bonne ligne et on peut continuer. ____________________ Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs. Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

CerberusPau · Answer

Nikel,

Pouvoir "parer" à un plantage de souris avec Echap ? 
Bof, mon utilisateur lambda m'aurait déjà appelé!

En revanche, cette sorte de "pause" lors d'une sélection peut pouvoir s'avérer utile.
En ce sens, j'envisage un message moins sibylin du style "Sélection en Pause: Cliquer sur Echap pour la reprendre".

Juste une remarque :
Dans le module tu me fais ajouter Public Sub valide()
    prepare = True
End Sub

Perso, je l'ai viré.
Mais tu avais peut-être une raison?

Voilà, je me dis que l'on pourrait peut-être conclure, puisque tu m'as aidé au-delà de mes attentes de départ et que tout tourne, tant dans l'exemple de travail qu'une fois intégré dans mon appli.

C'est bon pour toi aussi ?

Cordialement
Rataxes64

ucfoutu · Answer

oui, c'est une inadvertance de ma part.
La procédure valide n'a plus aucune raison d'être du tout. Supprime-là.
On peut conclure maintenant cette étape.
On passe maintenant à laquelle ?

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

Macro de Reprise de sélection multiple

93 réponses

Votre réponse

Discussions similaires