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
Reprise de données si - Forum SQL
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 81 / 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:29

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

Réponse 82 / 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:31

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

Réponse 83 / 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:37

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

Réponse 84 / 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 à 21:04

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

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

Posez votre question

Réponse 85 / 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 à 21:44

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

Réponse 86 / 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 à 22:40

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 sub

Private 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

Réponse 87 / 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 à 22:46

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

Réponse 88 / 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 à 22:55

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

Réponse 89 / 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 à 23:02

Merci!

J'intègre demain DANS mon appli et te tiens au courant.

Cordialement
Rataxes64

Réponse 90 / 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 à 23:28

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 oubler

Application.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

Réponse 91 / 93

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

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

Réponse 92 / 93

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

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

Réponse 93 / 93

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

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

Discussions similaires

Multiple definition of

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

Héritage multiple

Heritage et Constructeur

Héritage et protected

Votre réponse

Discussions similaires