XL 2016 Interdire le clique sur un bouton avant un autre

ReneDav14000

XLDnaute Occasionnel
Bonjour à toutes et à tous,

Dans mon application j'ai deux boutons : un qui est nommé "BoutZéro" qui efface certaines données de la feuille de calcul "BDD"
et un autre qui est nommé "BoutCopie" qui copie les lignes non vides dans une autre feuille "Temps"
J'aimerai savoir si il est possible d'empêcher l'utilisateur de cliquer sur le bouton "BoutZéro" tant qu'il n'a pas cliqué sur "BoutCopie".
Cela pour ne pas que l'utilisateur efface les données avant de les avoir copiées dans l'autre feuille "Temps"
Merci par avance pour votre aide

Voici le code pour le bouton "BoutZéro"
VB:
Private Sub BoutZéro_Click()
If MsgBox("Etes-vous certain de vouloir effacer les pointages horaires ? Cette action est irréversible - N'oubliez pas de copier les données avant l'effacement.", vbYesNo + vbQuestion, "Effacement des données") = vbYes Then

    Sheets("BDD").Select
    
Dim DerLigne As Long
    DerLigne = Sheets("BDD").Range("A1048576").End(xlUp).Row
    
        If DerLigne >= 6 Then
            Sheets("BDD").Range("G6:L" & DerLigne).Select
            
                Selection.ClearContents
End Sub
 
Solution
J'ai fait un essai, que je te livre tel quel...

Libre à toi de t'en inspirer, ou pas, bien sûr. ;)


ps : j'ai modifié "Tableau1" (intégration de la colonne "Date") et "Tableau2" (intégration de la colonne "Commentaires").
Je n'arrivais pas à bien discerner les limites des tableaux alors j'ai inséré une ligne au-dessus et une colonne à gauche, pour mieux voir les tableaux.

patricktoulon

XLDnaute Barbatruc
re
alors quand on parle de tableau structuré on parle plus de colonnes a,b x ou y
ton tableau structuré il commence en A si je comprends bien et se termine ou

a ben un truc comme ça ça se règle en deux minutes c'est ce qui a de bien avec les TS

Toutefois, c'est quand même tout le tableau1 qui est copié (sans les en-têtes)
heu.. non!! juste les visibles par filtre
met moi au moins une capture d'ecran des entes de TS si tu peux pas mettre de fichier
mais si ton TS commence en A les g à L sont les colonnes 7 à 14 du tableau
et si je te comprends bien on efface toutes ces colonnes sans supprimer les lignes
c'est bien ca ?
 

ReneDav14000

XLDnaute Occasionnel
Bonjour le forum,
patrick, j'ai mis le code en place selon tes recommandations et j'ai un message d'erreur sur le premier "Select Case.Caption (ligne 4)
" Erreur d'exécution '424' - Objet requis"

Je suis désolé de tarder à répondre, mais je ne suis pas toujours en pleine forme.
Je me mets sur mon projet dès que mon état de santé me le permet.
Mais bon on est pas là pour faire pleurer dans les chaumières.
Je joins mon fichier, mais je n'ai pas encore codé pour qu'il soit proportionnel à la taille de l'écran.

VB:
Private Sub BoutZéro_Click()
    With BoutCopie
    
        Select Case .Caption
    Case "Copie"
        Set C = Range("Tableau2").ListObject.ListRows.Add.Range.Cells(1)
        
        Range("Tableau1").SpecialCells(xlCellTypeVisible).Copy C
        .Caption = "Tout à zéro"
    
    Case "Tout à zéro"
        Range("Tableau1").Columns(7).Resize(, 6).ClearContents
        .Caption = "Copie"
        
        End Select
    End With
        
End Sub
 

Pièces jointes

  • Gestion_Heures_Camping_YB.xlsm
    322.3 KB · Affichages: 4

patricktoulon

XLDnaute Barbatruc
Bonjour
ben a part que tu pige rien et fait n'importe quoi
déjà la caption n’était pas bonne tu n'a pas modifié la caption ou le code
ensuite with boutcopie (incognito bataillon)
et pour finir une simple ligne comme celle ci
Set c = Range("Tableau2").ListObject.ListRows.Add.Range.Cells(1)
me plante sans aucune raison tout du moins il y en a certainement une mais la quelle ça ma fois

vous vous lancez dans de la conception d'app alors que vous n'avez même pas les bases minimum en vba
afin de vous auto contrôler dans vos codage
ça donne l'impression d’être simplement du copier coller
aujourd’hui je n'ai pas le temps je suis sur d'autres projet mais je regarderais demain

normalement le code c'est ça
VB:
Private Sub BoutZéro_Click()
    Dim c As Range
    With BoutZéro
    
        Select Case .Caption
    Case "Copie"
        Set c = Range("Tableau2").ListObject.ListRows.Add.Range.Cells(1)
        
        Range("Tableau1").SpecialCells(xlCellTypeVisible).Copy c
        .Caption = "Tout à zéro"
    
    Case "Tout à zéro"
        Range("Tableau1").Columns(7).Resize(, 6).ClearContents
        .Caption = "Copie"
        
        End Select
    End With
        
End Sub
et ton bouton c'est ça

1666107182800.png
 

ReneDav14000

XLDnaute Occasionnel
Bonjour
ben a part que tu pige rien et fait n'importe quoi
déjà la caption n’était pas bonne tu n'a pas modifié la caption ou le code
ensuite with boutcopie (incognito bataillon)
et pour finir une simple ligne comme celle ci

me plante sans aucune raison tout du moins il y en a certainement une mais la quelle ça ma fois

vous vous lancez dans de la conception d'app alors que vous n'avez même pas les bases minimum en vba
afin de vous auto contrôler dans vos codage
ça donne l'impression d’être simplement du copier coller
aujourd’hui je n'ai pas le temps je suis sur d'autres projet mais je regarderais demain

normalement le code c'est ça
VB:
Private Sub BoutZéro_Click()
    Dim c As Range
    With BoutZéro
  
        Select Case .Caption
    Case "Copie"
        Set c = Range("Tableau2").ListObject.ListRows.Add.Range.Cells(1)
      
        Range("Tableau1").SpecialCells(xlCellTypeVisible).Copy c
        .Caption = "Tout à zéro"
  
    Case "Tout à zéro"
        Range("Tableau1").Columns(7).Resize(, 6).ClearContents
        .Caption = "Copie"
      
        End Select
    End With
      
End Sub
et ton bouton c'est ça

Regarde la pièce jointe 1152673
Bonjour Patrick,
Je ne fais pas n'importe quoi puisque j'ai copié ton code comme tu me l'a dit. A part l'erreur sur le nom du bouton et le Dim, le code est identique.
Je te remercie pour ton aide, mais à présent je vais me débrouiller seul. Si ça ne marche pas je ne pourrais m'en prendre qu'à moi-même et je chercherais mes erreurs, j'y passerai certainement plus de temps, mais c'est comme ça que l'on apprends.
Toutes mes excuses pour ta perte de temps et encore merci
Peut-être à plus tard.
 

ReneDav14000

XLDnaute Occasionnel
Bonjour à tous,
Bon voilà ce que j'ai fait avec l'aide de patrick et de dysorthographie.
La copie se passe à peu-prés bien et l'effacement aussi.

Toutefois, la copie ne se fait pas sur la première ligne vide du tableau2 mais complètement à la fin. Le tableau comporte 18 lignes, les données sont copiées sur la 19ème alors qu'il n'y a rien avant.
Pouvez-vous juste m'expliquer mon erreur s'il vous plait ?
De plus je souhaiterai que ne soient copiées que les valeurs (pas de formats).
Mais j'ai également une erreur sur cette ligne :"Sheets("Temps").Range(C & derL).PasteSpecial xlPasteValues"
Merci par avance

Voici mes codes:

VB:
Private Sub BoutCopierColler_Click()

If BoutCopierColler.Caption = "Effacer" Then
   Call BoutZéro
        BoutCopierColler.Caption = "Copier"
Else
   Call BoutCopie
        BoutCopierColler.Caption = "Effacer"
End If
End Sub
''-----------------------
Sub BoutZéro()

If MsgBox("Etes-vous certain de vouloir effacer les horaires de pointage ?", vbYesNo + vbQuestion, "Effacement des données") = vbYes Then

        Sheets("BDD").Range("Tableau1").Columns(7).Resize(, 6).ClearContents
 End If
End Sub
''--------------------
Sub BoutCopie()
    Dim C As Range
    Dim derL As Long
    
    derL = Sheets("Temps").Range("B1048576").End(xlUp).Row
    
        
        Set C = Sheets("Temps").Range("Tableau2").ListObject.ListRows.Add.Range.Cells(1)
 
  Sheets("BDD").Range("Tableau1").Copy
Sheets("Temps").Range(C & derL).PasteSpecial xlPasteValues
 
End Sub
 
Dernière édition:

ReneDav14000

XLDnaute Occasionnel
Bonjour à tous,
Voici mon dernier jet. Mais il y toujours un message d'erreur sur la ligne 8.
Erreur d'exécution '424' - Objet requis

S'il vous plaît, ne me laissez pas en rade. Je vous joins également mon fichier.
Merci par avance

VB:
Sub BoutCopie()
Dim C As Range
Dim DerL As Long

DerL = Sheets("Temps").Cells(Rows.Count, 2).End(xlUp).Row
    
    
Set C = DerL & Sheets("Temps").Range("Tableau2").ListObject.ListRows.Add.Range.Cells(1)

Range("Tableau1").SpecialCells(xlCellTypeVisible).Copy C

C.Select

ActiveCell.PasteSpecial Paste:=xlPasteValues
End Sub
 

Pièces jointes

  • Gestion_Heures_Camping_YB.xlsm
    323 KB · Affichages: 4

Phil69970

XLDnaute Barbatruc
Bonjour à tous

Un essai ::

VB:
Sub BoutCopie()
Dim C As Range
'Dim DerL As Long

'DerL = Sheets("Temps").Cells(Rows.Count, 2).End(xlUp).Row
    
    
Set C = Sheets("Temps").Range("Tableau2").ListObject.ListRows.Add.Range.Cells(1)

Range("Tableau1").SpecialCells(xlCellTypeVisible).Copy C

'C.Select

'ActiveCell.PasteSpecial Paste:=xlPasteValues
End Sub

Merci de ton retour

@Phil69970
 

ReneDav14000

XLDnaute Occasionnel
Bonjour à tous

Un essai ::

VB:
Sub BoutCopie()
Dim C As Range
'Dim DerL As Long

'DerL = Sheets("Temps").Cells(Rows.Count, 2).End(xlUp).Row
   
   
Set C = Sheets("Temps").Range("Tableau2").ListObject.ListRows.Add.Range.Cells(1)

Range("Tableau1").SpecialCells(xlCellTypeVisible).Copy C

'C.Select

'ActiveCell.PasteSpecial Paste:=xlPasteValues
End Sub

Merci de ton retour

@Phil69970
Bonjour Phil69970,
Merci beaucoup de m'avoir répondu ainsi que TooFatBoy.
J'ai essayé le code, la copie se fait mais pas à l'endroit que je souhaiterai.
Dans la feuille "Temps" les données sont collées en ligne 7 alors qu'il n'y a rien à partir de la ligne 3.
De plus, les lignes vides de la feuille "BDD" sont également copiées, je pense que c'est normal puisque l'on copie le tableau.
Merci pour ton aide
 

TooFatBoy

XLDnaute Barbatruc
Je viens de regarder ton fichier, et tes tableaux structurés "Tableau1" et "Tableau2" n'ont pas la même structure, donc tu ne peux pas copier les données de l'un vers l'autre en une seule fois (sauf peut-être en masquant les colonnes à ne pas copier...).

Tu veux copier quoi exactement ?
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 113
Messages
2 085 430
Membres
102 889
dernier inscrit
monsef JABBOUR