Remise à zéro des valeurs et formats de 2 tableaux et pas 1 seul

Bonsoir,

Serait-il possible que le bouton "Mettre tout le tableau à zéro" agisse sur les 2 tableaux ci-dessous et pas seulement sur le "TBL_5Ateliers" mais aussi sur "Tabel8" des colonnes Z à AB ?

image

VBA du module7 ==>

Sub RAZ_5_ateliers()
     Application.ScreenUpdating = False

     'message d'avertissement
     If MsgBox("Attention, Toutes les données seront éffacées,Souhaitez-vous continuer?", vbYesNo + vbCritical + vbDefaultButton2, "effacement total") = vbNo Then Exit Sub

     With Range("TBL_5Ateliers").ListObject
          .Parent.Unprotect "seb"
          Application.Calculation = xlManual
          If .ListRows.Count > 1 Then .DataBodyRange.Offset(1).Resize(.ListRows.Count - 1).Delete
          .DataBodyRange.Range("A1:C1").ClearContents
          .DataBodyRange.Range("D1:W1").Value = 0
          Application.Calculation = xlCalculationAutomatic
          .Parent.Calculate
          .Parent.Protect "seb"
     End With
     Quadrillage_5_ateliers                  'application d'un Quadrillage_5_ateliers

End Sub

Merci beaucoup les passionnés

Sur le bouton "Débloquer ou Quitter", tapez vodoraix pour tt débloquer.

Et mot de passe pour débloquer les feuilles ==> seb

Bonne soirée

à bientô...

Bonsoir, tu peux tester

Range("Z3:AB99999").ClearContents

Bonjour et mci bcp

Je mets cette commande telle quelle et après celle-ci ?

.DataBodyRange.Range("A1:C1").ClearContents

Merci bcp

Bonne journée

Hello

Yes fais comme ça et dit nous

Paul

Bonjour Paul,

Ne faut-il pas déclarer le tableau "Tabel8" pour pouvoir effacer également le formatage de celui-ci ?

image

Mais je ne sais pas comment taper correctement le code

Sub RAZ_5_ateliers()
     Application.ScreenUpdating = False

     'message d'avertissement
     If MsgBox("Attention, Toutes les données seront éffacées,Souhaitez-vous continuer?", vbYesNo + vbCritical + vbDefaultButton2, "effacement total") = vbNo Then Exit Sub

     With Range("TBL_5Ateliers").ListObject
          .Parent.Unprotect "seb"
          Application.Calculation = xlManual
          If .ListRows.Count > 1 Then .DataBodyRange.Offset(1).Resize(.ListRows.Count - 1).Delete
          .DataBodyRange.Range("A1:C1").ClearContents
          Range("Z3:AB999").ClearContents
          .DataBodyRange.Range("D1:W1").Value = 0
          Application.Calculation = xlCalculationAutomatic
          .Parent.Calculate
          .Parent.Protect "seb"
     End With
     Quadrillage_5_ateliers                  'application d'un Quadrillage_5_ateliers

End Sub

Merci à toi Paul

à bientôt

Bonsoir,

Tu veux supprimer uniquement le contenu ou aussi le format(age)?

Paul

Bonjour Paul,

En tout cas, j'aimerais que sous les entêtes, plus rien n'apparaisse. Comme sous le tableau d'à côté.

Et lorsque je clique sur le bouton "Importer...", le formatage "Style de tableau", se reforme comme il faut

Merci

Bonne journée

Hello,

J'espère avoir bien compris ta requête et que ça peut t'aider, en amont pense à déclarer ta plage de cellule en tableau et renomme le par exemple "tab_droite"

Pour vider les valeurs uniquement

Range("tab_droite").ClearContents

Pour supprimer le formatage et avoir tout en blanc

With Range("tab_droite")
    .Interior.Color = vbWhite
    .Borders.LineStyle = xlNone
End With

Et pour remettre en formatage de tableau classique on va dire::

Dim lo As ListObject
On Error Resume Next
Set lo = ActiveSheet.ListObjects("tab_droite")
On Error GoTo 0

If Not lo Is Nothing Then
    lo.TableStyle = "TableStyleMedium2" ' Style par défaut (alternance de lignes, bordures)
End If

Paul

Bonjour à tous,

@PaulExcelVBA, Range("tab_droite").ClearContents ce n'est pas une bonne solution que d'appliquer la méthode ClearContent, en effet pour les tableaux structurés nul besoin de garder des lignes vides c'est contre-productif.

@vodoraix il faut faire deux manipulations

  • Dans le module 5 (Qu'il faudrait renommer) remplacer la procédure RAZ_5_ateliers() par la procédure FiveAteliersClearAllTabs() ci-dessous
  • Faire un clic droit sur le bouton de la feuille 5 Ateliers (Feuil2) puis cliquer sur affecter une macro, et enfin sélectionner la nouvelle macro :FiveAteliersClearAllTabs()
'@Description "Supprime les données des tableaux 'TBL_5Ateliers' et 'TBL_5Ateliers'."
Public Sub FiveAteliersClearAllTabs()
    Dim deleteAllTabs As Boolean
    Dim itemListObject As Excel.ListObject
    On Error GoTo Catch
    Application.EnableEvents = False
    If MsgBox("Attention, Toutes les données des deux tableaux seront éffacées, Souhaitez-vous continuer ?", vbYesNo + vbCritical + vbDefaultButton2, "effacement total") = vbYes Then
        Set itemListObject = Feuil2.Range("TBL_5Ateliers").ListObject
        If Not itemListObject Is Nothing Then
            With itemListObject
                If .ListRows.Count > 0 Then
                    .DataBodyRange.Delete
                Else
                    'TODO Message ? le tableau est vide
                End If
            End With
        Else
            'TODO Message ? Pas de tableau
        End If
        If Not itemListObject Is Nothing Then Set itemListObject = Nothing
        Set itemListObject = Feuil2.Range("TBL_5Ateliers").ListObject
        If Not itemListObject Is Nothing Then
            With itemListObject
                If .ListRows.Count > 0 Then
                    If deleteAllTabs = True Then .DataBodyRange.Delete
                Else
                    'TODO Message ? Le tableau est vide
                End If
            End With
        Else
            'TODO Message ? Pas de tableau
        End If
    End If

Finally:
    Application.EnableEvents = True
    Exit Sub

Catch:
    ' // Do something.
    MsgBox "Oupss... Nous avons rencontré une erreur : " & Err.Number & _
           " (" & Err.Description & ") dans la procédure FiveAteliersClearAllTabs du Module Module7"

    Resume Finally

End Sub

Bonsoir Paul & Jean-Paul et merci beaucoup pour votre aide

J'ai plusieurs petites erreurs que j'aurai du mal à corriger car je n'y connais rien en programmation :

- J'ai une erreur aléatoire ==> Oupss (parfois au tout début et parfois après la création de qqes lignes)

- Je n'ai pas les valeurs "0" sur la première ligne.

- Le fond des cellules sont en noires alors que j'ai préparé des MFC qui ne sont plus prises en compte.

- Le tableau Tabel8 ne s'efface pas.

image

à bientôt et encore merci à vous 2.

Bonne soirée

Re,

Oui je pense que cela est du à la protection de la feuille, j'ai tapé le code vite fait et je n'y ai pas pensé.

Procédure mise à jour :

'@Description "Supprime les données des tableaux 'TBL_5Ateliers' et 'TBL_5Ateliers'."
Public Sub FiveAteliersClearAllTabs()
    Dim deleteAllTabs As Boolean
    Dim itemListObject As Excel.ListObject
    On Error GoTo Catch
    Application.EnableEvents = False
    If MsgBox("Attention, Toutes les données des deux tableaux seront éffacées, Souhaitez-vous continuer ?", vbYesNo + vbCritical + vbDefaultButton2, "effacement total") = vbYes Then
        Set itemListObject = Feuil2.Range("TBL_5Ateliers").ListObject
        If Not itemListObject Is Nothing Then
            With itemListObject
                If .ListRows.Count > 0 Then
                    If Feuil2.ProtectContents Then Feuil2.Unprotect Password:=GlobalConstants.SHEETS_MDP
                    .DataBodyRange.Delete
                Else
                    'TODO Message ? le tableau est vide
                End If
            End With
        Else
            'TODO Message ? Pas de tableau
        End If
        If Not itemListObject Is Nothing Then Set itemListObject = Nothing

        Set itemListObject = Feuil2.Range("Tabel8").ListObject
        If Not itemListObject Is Nothing Then
            With itemListObject
                If .ListRows.Count > 0 Then
                    If Feuil2.ProtectContents Then Feuil2.Unprotect Password:=GlobalConstants.SHEETS_MDP
                    .DataBodyRange.Delete
                Else
                    'TODO Message ? le tableau est vide
                End If
            End With
        Else
            'TODO Message ? Pas de tableau
        End If
    End If

Finally:
    Feuil2.Protect Password:=GlobalConstants.SHEETS_MDP
    Application.EnableEvents = True
    Exit Sub

Catch:
    ' // Do something.
    MsgBox "Oupss... Nous avons rencontré une erreur : " & Err.Number & _
           " (" & Err.Description & ") dans la procédure FiveAteliersClearAllTabs du Module Module7"

    Resume Finally

End Sub

Assurez-vous qu'un module 'GlobalConstants' est présent, et contient les constantes :

Option Explicit

Public Const SHEETS_MDP As String = "seb"
Public Const APPLICATION_MDP As String = "vodoraix"
Public Const POSITION_TO_ADD_ON_TAB As Long = 0

On y est presque

Vui l'option Explicit existe bien et est identique à celle conseillée

J'ai juste les premières lignes des 2 tableaux qui conservent les fonds de cellules de leurs entêtes.

Encore merci

image

re,

C'est tout à fait normal vous avez formater certaines cellules de la feuille, mais ce n'est pas pris en compte sur le format du tableau. Donc dans l'ordre :

  • Sélectionner les lignes 2 à 8
    • Onglet Accueil Groupe police :
      • Supprimer la mise en gras.
      • Supprimer les bordures
      • Passer sur Aucun remplissage
  • Cliquez sur une cellule du tableau 'Tabel8'
    • Ruban/Création de tableau groupe style de tableau cliquer sur nouveau style
    • Une fenêtre s'ouvre vous pouvez définir le style de vos tableaux.

Renouveler l'opération pour l'autre tableau.

Les cellules qui ne font pas partie des tableau peuvent être formatées comme à l'habitude.

nb pour les lignes et les colonnes elles vont par deux, si vous voulez que toutes les lignes du tableau Tabl8 soient identiques mettez leurs le même format.

P.S. Avez vous testé le fichier fourni la dernière fois ? Vous avez les commandes sur le ruban :

image

Les commandes s'adaptent selon la feuille qui est active (Test avec la feuille 5 Ateliers)

image

Ici avec la feuille Classmt par discipline+Général

Je suis en attente de savoir si le contexte vous plaît pour continuer.

bonjour le fil,

j'ai crée une macro paramétrée parce qu'on l'utilisera plus tard pour les 2 autres feuilles

Sub RAZ_5_ateliers()
     RAZ_Tous_Les_Ateliers Range("TBL_5Ateliers").ListObject, Range("Tabel8").ListObject     'macro paramétré avec les 2 TS de votre feuille
End Sub

Sub RAZ_9Cibles()
     RAZ_Tous_Les_Ateliers Range("TBL_premier de 9 cibles").ListObject, Range("Tabel 2 de 9 cibles").ListObject     'macro paramétré avec les 2 TS de votre feuille
End Sub

Sub RAZ_Tous_Les_Ateliers(LO1 As ListObject, LO2 As ListObject)
     Dim sh    As Worksheet
     Set sh = LO1.Parent
     If sh.Name <> LO2.Parent.Name Then MsgBox "2 feuilles différentes", vbCritical: Exit Sub
 ....

Donc la macro "RAZ_5_Ateliers" saute vers la macro "RAZ_Tous_Les_Ateliers" avec ses 2 paramètres, ses 2 tableaux structurés. Pour les 2 autres feuilles, on n'a pas encore des TS là, donc, ce sera un tout petit boulot et on peut utiliser la même macro (voir macro "RAZ-9cibles" mais les noms des tableaux sont encore faux).

Il faut savoir que c'est inutile de donner le nom de la feuille pour un listobject dans un module normal (cela n'est pas vrai dans le module d'une feuille). Donc dans mes macros vous verrez ".parent" quand je veux savoir la feuille. A la limite, on peut déplacer un TS vers une autre feuille sans qu'on doit modifier VBA, si tout est bien fait ()

Vous verrez aussi que pour le premier TS, je ne supprime pas le databodyrange complèt, je maintiens la première ligne pour conserver les MFCs (il y a quelqu'unes qui ne fonctionnent plus, si je supprime la première ligne )

J'ai juste 2 MFC qui se dérèglent et restent sur Y2 alors que c'était sur Y3 pour que ça marche...

Une solution, stp ?

MErci encore pour ta précieuse aide

image

Pour le ruban et ton classeur zippé, j'ai un risque potentiel sur l'ouverture des macros

Bonsoir Bart' et merci beaucoup pour ta millième aide

Vui et bravo, merci beaucoup de préparer la macro pour les 2 autres feuilles !!!!!!!!!!!!!!!

J'ai juste une erreur comme ci-dessous mais pas toujours car j'ai refait 2 autres tests, et cette erreur n'apparaît plus

image

Sinon, il faudrait que j'agisse sur les 2 autres feuilles, notamment pour mieux titrer les entêtes et en faire des TS, c'est ça ?

MErci encore

Ces entêtes ne sont pas bonnes pour un TS, il faut du texte aussi ?

image

oei, mauvaise copie&colle, 2 fautes ...

  With LO2
          If .ListRows.Count Then .DataBodyRange.Delete     'on peut tout supprimer ici(aucune MFC délicate)
     End With

     Application.ScreenUpdating = True
     Application.EnableEvents = True
     Application.Calculation = xlManual
     sh.Protect "seb"                        '<<<<<<<<< PROTECT au lieu de UNPROTECT
     Application.Calculation = xlCalculationAutomatic
     sh.Calculate                            '<<<<<< SH au lieu de ".PARENT"

     Quadrillage_5_ateliers                  'ce quadrillage ne fonctionne plus depuis quelque jours !!!!!!

End Sub

au moment où tu transforme la plage en tableau structuré, les entêtes se changent en "texte", donc aucun problème avec ces entêtes numériques, ce seront des textes et ne plus des chiffres.

d'acc pour les entêtes !!!!!!!

Et, yes & re-yes pour le nouveau VBA. J'ai fait plusieurs tests et c'est nickel.

Merci beaucoup Bart'...

Bonne soirée...

Il suffit maintenant que je récupère ton code :

Sub RAZ_9Cibles()
     RAZ_Tous_Les_Ateliers Range("TBL_premier de 9 cibles").ListObject, Range("Tabel 2 de 9 cibles").ListObject     'macro paramétré avec les 2 TS de votre feuille
End Sub

et que je le mette dans le module9 du "9 cibles" avec les bon noms de tableau et aussi que je supprime le Sub RAZ_9_cibles() et que j'adapte le bouton RAZ à la nouvelle macro "RAZ_Tous_Les_Ateliers"...Pas vrai ?

On s'approche du bon résultat, nan ?

Est-ce que ton élève (moi), t'impressionne ou t'impressionne ? Nan j'rigole... j'essaye juste de comprendre un peu le sens global de ta programmation

Bonne soirée Bart' et encore merci. Tu me sauves, encore & encore

Rechercher des sujets similaires à "remise zero valeurs formats tableaux pas seul"