Saisie identique multi zones

  • Initiateur de la discussion Initiateur de la discussion loridam
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

L

loridam

Guest
Bonjour, le forum

Je dois mettre des croix (caractère X) dans une sélection multiple que j'ai sélectionnée.

Comment écrire ça en VBA.

Merci pour votre aide.
 
Bonjour loridam, le Forum,

Un exemple (changer les valeurs A1 (ou j'ai mis le X et la zone B4😀25 ou j'ai coller.
Réalisé avec l'enregistreur de macros.

Sub Macro1()
Range('A1').Select
Selection.Copy
Range('B4😀25').Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Bonne journée.
 
Bonjour loridam, marc 🙂

marc, loridam nous précise qu'il ne veut placer les X que dans les cellules sélectionnées, et ton code sélectionne automatiquement b4:d25.

Une autre approche de ton code en supprimant également les select inutiles 🙂 :


Sub Bouton2_QuandClic()

Range('A1').Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=
False, Transpose:=False
End Sub


et ma propre contribution :


Sub Bouton1_QuandClic()
Dim c As Range

For Each c In Selection: c = 'X': Next c

End Sub

je vous souhaite une bonne journée

salut
 
Bonjour Marc et Hervé

Merci pour votre aide

La réponse d'Hervé me convient parfaitement.

Je voudrais maintenant que la macro s'exécute que si ma sélection multiple se trouve dans la zone B6:AF85

Par exemple si je sélectionne A1:A2 et B7:AF7 simultanément, il s'affiche un message 'Mauvaise sélection!'

Est-ce possible?
 
Bonjour loridam, Marc et Hervé, bonjour à toutes et à tous 🙂

Une solution possible en reprenant le code d'Hervé (merci Hervé !) 😛 :

Sub Bouton1_QuandClic()
'
Dim C As Range
'
  With Intersect(Selection, Range('B6:AF85'))
    If Not .Cells Is Nothing Then
      If .Count = Selection.Count Then
        For Each C In Selection
          C = 'X'
        Next C
        Exit Sub
      End If
    End If
  End With
  MsgBox 'Mauvaise Sélection'
End Sub

Voili voilà

Tiens-nous au courant.

A+ 😉
 
Bonjour Charly2

Ton code correspond à ma demande, une seule erreur à priori.

Quand je sélectionne toutes les cellules à l'extérieur de la plage B6:AF85, il y a une erreur sur la ligne
If Not .Cells Is Nothing Then

Si je sélectionne une plage à l'intérieur et une à l'extérieur, c'est bon : le message s'affiche.


Si je sélectionne plusieurs plages à l'intérieur , c'est bon aussi: les croix s'affichent.

je te joins mon fichier.

@ bientôt
 
re loridam, marc, salut charly 🙂

de rien charly 🙂

un tout petit peu plus court, facilement améliorable :


Sub Marquage_Abs()
Dim oIntersect As Range
'
Set oIntersect = Intersect(Selection, Range('B6:AF85'))
If Not oIntersect Is Nothing Then
       
If oIntersect.Count = Selection.Count Then Selection = 'X': Exit Sub
End If
MsgBox 'Mauvaise Sélection !'
End Sub

salut
 
Salut loridam
bonsoir mes Amis Hervé et Charly
une version tirée de vos propositions plage interieure exterieure ????? lol
arff faut il encore que ce soit ce qu'il recherche LOL
même si tu sélectionnes des cellules en exterieur seules les cellules concernées sont prisent en compte Lol Arffff
Sub Marquage_Abs()
Dim oIntersect As Range
'
Set oIntersect = Intersect(Selection, Range('B6:C10'))
If Not oIntersect Is Nothing Then
oIntersect = 'X': Exit Sub
End If
MsgBox 'Mauvaise Sélection !'
End Sub

Bonne fin de Journée
 
Merci à tous,

Les solutions de vous trois marchent bien et répondent à mes besoins.

Je voulais vérifier la sélection de mes cellules pour éviter l'effacement des cellules hors de la zone F6:AF85 lors d'un clic indésirable sur le bouton des utilisateurs.

@ bientôt pour d'autres sollicitations!
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
10
Affichages
513
Réponses
10
Affichages
412
Retour