Macro de Reprise de sélection multiple

Résolu

CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 - 28 janv. 2012 à 13:06
CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 - 20 févr. 2012 à 11:22

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

A voir également:

Multiple reprise
Héritage multiple c# ✓ - Forum C# / .NET
C# héritage multiple ✓ - Forum C# / .NET
Arrondi au multiple - Forum Visual Basic 6
C# socket server multiple clients - Forum C# / .NET
C# heritage multiple - Forum C# / .NET

93 réponses

Réponse 61 / 93

CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 1
13 févr. 2012 à 12:02

Voici ce que j'ai fait.

Dans la feuille Achives

Private 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 Archives

Sub 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

Réponse 62 / 93

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
13 févr. 2012 à 12:52

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

Réponse 63 / 93

CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 1
13 févr. 2012 à 13:20

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()

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

Réponse 64 / 93

CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 1
13 févr. 2012 à 13:22

Autre chose

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

Rataxes64

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 65 / 93

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
14 févr. 2012 à 11:28

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

Réponse 66 / 93

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
14 févr. 2012 à 19:53

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

Réponse 67 / 93

CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 1
16 févr. 2012 à 19:42

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

Cordialement
Rataxes64

Réponse 68 / 93

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
16 févr. 2012 à 19:46

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

Réponse 69 / 93

CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 1
17 févr. 2012 à 15:49

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 MsgBox

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
                '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

Réponse 70 / 93

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
17 févr. 2012 à 16:32

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

Réponse 71 / 93

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
17 févr. 2012 à 17:16

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

Réponse 72 / 93

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
17 févr. 2012 à 17:20

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

Réponse 73 / 93

CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 1
17 févr. 2012 à 18:26

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

Réponse 74 / 93

CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 1
17 févr. 2012 à 18:32

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

Réponse 75 / 93

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
17 févr. 2012 à 18:35

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

Réponse 76 / 93

CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 1
17 févr. 2012 à 18:53

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

Réponse 77 / 93

CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 1
17 févr. 2012 à 18:58

OK.

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

Cordialement
Rataxes64

Réponse 78 / 93

CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 1
17 févr. 2012 à 19:43

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

Réponse 79 / 93

CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 1
17 févr. 2012 à 20:20

Juste une question:

Peut-on gérer prepare = True depuis un bouton sur une autre feuille ?

Cordialement
Rataxes64

Réponse 80 / 93

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
17 févr. 2012 à 20:27

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

Discussions similaires

Multiple definition of

VBA Access : DoCmd.ApplyFilter ..... HELP ....

Héritage multiple

Heritage et Constructeur

pb script reprise de données

Votre réponse

Discussions similaires