XL 2016 Interdire le clique sur un bouton avant un autre

R

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
TooFatBoy
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.
Trier par date Trier par votes
patricktoulon

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)
Cliquez pour agrandir...
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 ?
 
Vote positif 0 Vote négatif
R

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
Vote positif 0 Vote négatif
patricktoulon

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)
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
R

ReneDav14000

XLDnaute Occasionnel
patricktoulon à dit:
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
Cliquez pour agrandir...
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.
 
Vote positif 0 Vote négatif
R

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:
Vote positif 0 Vote négatif
R

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
Vote positif 0 Vote négatif
Phil69970

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
 
Vote positif 0 Vote négatif
R

ReneDav14000

XLDnaute Occasionnel
Phil69970 à dit:
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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
TooFatBoy

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:
Vote positif 0 Vote négatif

Discussions similaires

L
  • Question
Microsoft 365 Faire agir une macro en fonction de l'emplacement du bouton
Réponses
2
Affichages
291
AtTheOne
AtTheOne
Chaton77
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
329
Chaton77
Chaton77
F
  • Question
XL 2021 Liste déroulante vers un autre classeur
Réponses
1
Affichages
247
Dudu2
Dudu2
M
  • Question
XL 2010 Créer un bouton de restauration
Réponses
12
Affichages
970
mostefa mokhtar
M
N
  • Résolu(e)
Microsoft 365 Transfère de données d'un Userform vers un tableau structuré d'une feuille de calcul
Réponses
4
Affichages
145
NONO14
N
PatFr38
  • Résolu(e)
Microsoft 365 Code VBA pour vérifier si lignes masquées le sont bien
2
Réponses
16
Affichages
1 K
PatFr38
PatFr38
R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
479
robpellan52
R
chaelie2015
  • Question
XL 2013 Modifier un code de sauvegarde
2
Réponses
16
Affichages
826
chaelie2015
chaelie2015
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Adapter un code
Réponses
8
Affichages
529
TooFatBoy
TooFatBoy
S
  • Question
Microsoft 365 VBA Requette SQL sur un autre fichier excel
Réponses
13
Affichages
348
dysorthographie
dysorthographie

Membres actuellement en ligne

17 membres et 352 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 491
Messages
2 110 177
Membres
110 690
dernier inscrit
Zeppelin