Selection.ClearContents

[Evelynetfrancois]

Bonjour tout le monde ......

Dans mon programme j ai sur un bouton

Private Sub CommandButton2_Click()
Selection.ClearContents
End Sub

Qui me renvoie automatiquement sur la macro suivante,( puisqu il y a changement !!) mais cette macro contient un MsgBox

Private Sub Worksheet_Change(ByVal Target As Range)
............
..........
MsgBox.........................................
End Sub

Est t il possible de contourner cette macro uniquement lorsque je clear ma feuille ?pour ne pas avoir cette MsgBox ?
puis-je rajouter une ligne "mystere" dans Private Sub CommandButton2_Click()?

bonne journée
E et F

 

[ChTi160]

Re : Selection.ClearContents

re evelyne

cela veut dire par exemple

en dehors de toute procèdure ,en tête du module

Option Explicit

Public Flag as Boolean

Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Range("D3:E600").Activate
Flag= True
etc etc

en espèrant t'avoir permis d'avancer
Bonne fin de Soirée

 

[Evelynetfrancois]

Re : Selection.ClearContents

merci Pascal76 pierrot93 Spitnolan08 et ChTi160
Voila CHTI c est parfait , c'est bien cette ligne qui me faisait defaut !!
merci pour tout et bonne soirée
E et F

 

[Pierrot93]

Re : Selection.ClearContents

Bonjour à tous

Sauf erreur de ma part, le bogue sur le test -Target <> """-, doit être du à la modification simultanée de plusieurs cellules.
L'objet range "target" contient alors x valeurs, peut être qu'une boucle "For Each" permettrait de solutionner le problème.

Par contre peut être un peu lourd à gérer en fonction du nombre de cellules contenues dans "target"...

A voir et à tester selon les cas...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
If Not Application.Intersect(Target, Range("E3:E65536")) Is Nothing Then
For Each cell in Target
if Target <> "" then
RETOUR = MsgBox("Voulez-vous valider cette commande ", 4 + vbInformation, " V A L I D A T I O N ")
If RETOUR = vbYes Then
Application.ScreenUpdating = False
Range("A" & ActiveCell.Row & ":F" & ActiveCell.Row).Copy
Sheets("Fiche").Range("A65536").End(xlUp).Offset(1 , 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End If
End If
Next Cell
end If
End Sub

Bonne journée
@+

 

[Bernard_XLD]

Re : Selection.ClearContents

Salut tout le monde

comme il n'y a apparemment plus personne en ligne, je me permets
voici ton code légérement modifié, devrait sans doute mieux fonctionner
j'ai enlevé la double négation et inversé le test cellule, j'ai également modifié la copie de cellules et rétabli target en tant qu'origine.

A+

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
If Application.Intersect(Target, Range("E3:E65536")) Then
For Each Cell In Target
If Target.Value = "" Then Else
RETOUR = MsgBox("Voulez-vous valider cette commande ", 4 + vbInformation, " V A L I D A T I O N ")
If RETOUR = vbYes Then
Application.ScreenUpdating = False
Range("A" & Target.Row & ":F" & Target.Row).Copy
Sheets("Fiche").Range("A65536").End(xlUp).Range("A2:F2").Value = Range("A" & Target.Row & ":F" & Target.Row).Value
Application.CutCopyMode = False
Application.ScreenUpdating = True
End If
End If
Next Cell
End If
End Sub

 

[Bernard_XLD]

Re : Selection.ClearContents

trop vite

comme cela ce sera mieux

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
If Application.Intersect(Target, Range("E3:E65536")) Then
    Application.ScreenUpdating = False
    For Each Cell In Target
        If Not (Target.Value = "") Then
            RETOUR = MsgBox("Voulez-vous valider cette commande ", 4 + vbInformation, " V A L I D A T I O N ")
            If RETOUR = vbYes Then
                Sheets("Fiche").Range("A65536").End(xlUp).Range("A2:F2").Value = Range("A" & Target.Row & ":F" & Target.Row).Value
            End If
        End If
    Next Cell
    Application.ScreenUpdating = True
End If
End Sub

 

[Bernard_XLD]

Re : Selection.ClearContents

décidément

cela m'apprendra à tester avant d'envoyer

par contre cela suppose que A ne soit jamais vide car sinon la ligne de fiche sera écrasée à la prochaine copie, il serait plus logique de faire le test de ligne libre sur E car c'est E qui conditionne la copie
cela donnerait quelque chose comme
Sheets("Fiche").Range("E65536").End(xlUp).Offset(0, -4).Range("A2:F2").Value = Range("A" & Cell.Row & ":F" & Cell.Row).Value

A+

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
If Application.Intersect(Target, Range("E3:E65536")) Is Nothing Then
Else
    Application.ScreenUpdating = False
    For Each Cell In Target
        If Cell.Column = 5 And Not (Cell.Value = "") Then
            If MsgBox("Voulez-vous valider cette commande ", 4 + vbInformation, " V A L I D A T I O N ") = vbYes Then
                Sheets("Fiche").Range("A65536").End(xlUp).Range("A2:F2").Value = Range("A" & Cell.Row & ":F" & Cell.Row).Value
            End If
        End If
    Next Cell
    Application.ScreenUpdating = True
End If
End Sub