Note: The other languages of the website are Google-translated. Back to English
English English

Comment garder le tableau extensible en insérant une ligne de tableau dans une feuille de calcul protégée dans Excel?

La fonction d'expansion automatique du tableau sera perdue après la protection de la feuille de calcul dans Excel. Par exemple, il existe une table nommée Table1 dans votre feuille de calcul protégée, lorsque vous tapez quelque chose sous la dernière ligne, la table ne se développe pas automatiquement pour inclure la nouvelle ligne. Existe-t-il une méthode pour garder le tableau extensible en insérant une nouvelle ligne dans une feuille de calcul protégée? La méthode décrite dans cet article peut vous aider à y parvenir.

Gardez le tableau extensible en insérant une ligne de tableau dans une feuille de calcul protégée avec le code VBA


Gardez le tableau extensible en insérant une ligne de tableau dans une feuille de calcul protégée avec le code VBA


Comme illustré ci-dessous, une table nommée Table1 dans votre feuille de calcul et la dernière colonne de la table est une colonne de formule. Vous devez maintenant protéger la feuille de calcul pour éviter que la colonne de formule ne change, mais permettre d'agrandir le tableau en insérant une nouvelle ligne et en attribuant de nouvelles données dans les nouvelles cellules. Veuillez faire comme suit.

1. Cliquez Développeur > insérer > Bouton (contrôle de formulaire) pour insérer un Contrôle de formulaire bouton dans votre feuille de calcul.

2. Dans le pop-up Attribuer une macro boîte de dialogue, cliquez sur le Nouveautés .

3. dans le Microsoft Visual Basic pour applications , veuillez copier et coller le code VBA ci-dessous entre le Sol et des tours End Sub paragraphes dans le Code fenêtre.

Code VBA: gardez le tableau extensible en insérant une ligne de tableau dans une feuille de calcul protégée

 'Update by ExtendOffice 20220826
    Dim xRg, tableRg As Range
    Dim xRowCount As Integer
    Dim pswStr As String
    pswStr = "123"
    On Error Resume Next
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:=pswStr

    Set tableRg = ActiveSheet.ListObjects("Table4").Range
    xRowCount = tableRg.Rows.Count
    
    Set xRg = Range("Table4[[#Headers],[Total]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault

    ActiveSheet.Protect Password:=pswStr, DrawingObjects:=False, _
                    Contents:=True, Scenarios:=False, _
                    AllowFormattingCells:=True, AllowFormattingColumns:=True, _
                    AllowFormattingRows:=True, AllowInsertingColumns:=True, _
                    AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _
                    AllowDeletingColumns:=True, AllowDeletingRows:=True, _
                    AllowSorting:=True, AllowFiltering:=True, _
                    AllowUsingPivotTables:=True
    Application.ScreenUpdating = True

Notes:

1). Dans le code, le numéro «123» est le mot de passe que vous utiliserez pour protéger la feuille de calcul.
2). Veuillez modifier le nom de la table et le nom de la colonne contenant la formule que vous protégerez.

4. appuie sur le autre + Q touches pour fermer la fenêtre Microsoft Visual Basic pour Applications.

5. Sélectionnez les cellules du tableau dans lesquelles vous devez affecter de nouvelles données, à l'exception de la colonne de formule, puis appuyez sur le bouton Ctrl + 1 clés pour ouvrir le Format de cellule boite de dialogue. dans le Format de cellule boîte de dialogue, décochez la case Fermé , puis cliquez sur le OK bouton. Voir la capture d'écran:

6. Protégez maintenant votre feuille de calcul avec le mot de passe que vous avez spécifié dans le code VBA.

À partir de maintenant, après avoir cliqué sur le bouton Contrôle de formulaire dans votre feuille de calcul protégée, le tableau sera extensible en insérant une nouvelle ligne comme illustré ci-dessous.

Notes: vous pouvez modifier le tableau sauf la colonne de formule dans la feuille de calcul protégée.


Articles connexes:


Les meilleurs outils de productivité de bureau

Kutools for Excel résout la plupart de vos problèmes et augmente votre productivité de 80%

  • Réutilisation: Insérer rapidement formules complexes, graphiques et tout ce que vous avez utilisé auparavant; Crypter les cellules avec mot de passe; Créer une liste de diffusion et envoyer des e-mails ...
  • Barre Super Formula (modifiez facilement plusieurs lignes de texte et de formule); Disposition de lecture (lire et modifier facilement un grand nombre de cellules); Coller dans la plage filtréeplus
  • Fusionner les cellules / lignes / colonnes sans perdre de données; Contenu des cellules divisées; Combiner des lignes / colonnes en double... Empêcher les cellules en double; Comparer les gammesplus
  • Sélectionnez Dupliquer ou Unique Lignes; Sélectionnez les lignes vides (toutes les cellules sont vides); Super Find et Fuzzy Find dans de nombreux classeurs; Sélection aléatoire ...
  • Copie exacte Plusieurs cellules sans changer la référence de formule; Créer automatiquement des références à plusieurs feuilles; Insérer des puces, Cases à cocher et plus encore ...
  • Extrait du texte, Ajouter du texte, Supprimer par position, Supprimer l'espace; Créer et imprimer des sous-totaux de pagination; Conversion entre le contenu et les commentaires des cellulesplus
  • Super filtre (enregistrer et appliquer des schémas de filtrage à d'autres feuilles); Tri avancé par mois / semaine / jour, fréquence et plus; Filtre spécial par gras, italique ...
  • Combiner des classeurs et des feuilles de travail; Fusionner les tableaux en fonction des colonnes clés; Diviser les données en plusieurs feuilles; Conversion par lots xls, xlsx et PDFplus
  • Plus de 300 fonctionnalités puissantes. Prend en charge Office / Excel 2007-2019 et 365. Prend en charge toutes les langues. Déploiement facile dans votre entreprise ou organisation. Essai gratuit de 30 jours. Garantie de remboursement de 60 jours.
onglet kte 201905

Office Tab apporte une interface à onglets à Office et simplifie considérablement votre travail

  • Activer l'édition et la lecture par onglets dans Word, Excel, PowerPoint, Publisher, Access, Visio et Project.
  • Ouvrez et créez plusieurs documents dans de nouveaux onglets de la même fenêtre, plutôt que dans de nouvelles fenêtres.
  • Augmente votre productivité de 50% et réduit des centaines de clics de souris chaque jour!
bas de cabine
Commentaires (18)
Pas encore de notes. Soyez le premier à évaluer!
Ce commentaire a été minimisé par le modérateur sur le site
J'ai donc essayé ceci, mais cela ajoute une nouvelle ligne au bas du classeur sur la ligne 1048576, mais ma table ne contient qu'environ 800 enregistrements. Je ne sais pas pourquoi ça fait ça !
Ce commentaire a été minimisé par le modérateur sur le site
Salut Brindi,
Le code a été mis à jour avec le problème résolu, veuillez essayer et merci pour votre commentaire.
Ce commentaire a été minimisé par le modérateur sur le site
Salut Crystal, le problème est le même. J'ai créé une nouvelle table pour moi avec seulement 2 lignes. Une fois que je clique sur le bouton, la liste est développée jusqu'à la fin du tableau sans ajouter de lignes. Il devrait être ajouté à la ligne numéro 3.
Ce commentaire a été minimisé par le modérateur sur le site
Salut Crystal, le problème est le même. J'ai créé une nouvelle table pour moi avec seulement 2 lignes. Une fois que je clique sur le bouton, la liste est développée jusqu'à la fin du tableau sans ajouter de lignes. Il devrait être ajouté à la ligne numéro 3.
Ce commentaire a été minimisé par le modérateur sur le site
Essayez ce code Vba pour ajouter une nouvelle ligne dans votre table

Sous Tab_Line_Add()
Dim pswStr As String
pswStr = "123"
On Error Resume Next
Application.ScreenUpdating = Faux
ActiveSheet.Unprotect Password :=pswStr
ActiveSheet.Range("D8").Sélectionner
'D8 est l'en-tête du tableau
Range("Table1[[#Headers],[Total]]").Select
Selection.End (xlDown) .Sélectionnez
Selection.ListObject.ListRows.Add AlwaysInsert :=Faux
Mot de passe ActiveSheet.Protect :=pswStr

End Sub
.
Ce commentaire a été minimisé par le modérateur sur le site
Salut Mac,
Merci d'avoir partagé.
Ce commentaire a été minimisé par le modérateur sur le site
l'utilisation de la suggestion (Selection.ListObject.ListRows.Add AlwaysInsert:=False) a résolu un problème similaire pour moi avec le code d'origine, où une nouvelle ligne complète (s'étendant vers le bas des formules contenues dans la cellule) ne serait pas ajoutée à la table sur un beaucoup plus large tableau 51 colonnes. Alors merci pour le partage et la réparation de Mac.
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour, j'ai utilisé le code ci-dessus et j'ai le message d'erreur suivant :
"L'exécution du code a été interrompue". Lorsque je clique sur Debug, la ligne 20 "Selection.ClearContents" est mise en surbrillance.

Lorsque j'ai entré le code pour la première fois, cela a fonctionné correctement.

J'ai remplacé "Table" par le nom de la table et changé la colonne par le nom de la colonne que j'utilise. J'ai également modifié le "Selection.Offset (x,-x).Select" pour répondre à mes besoins.


Des suggestions quant à la raison pour laquelle cela se produit?
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour,

le code a fonctionné au départ, mais après avoir dupliqué la feuille de calcul, il est resté après 24 heures, puis tout le code a disparu. Et maintenant, je ne peux pas accéder à la feuille de calcul.

il n'arrête pas de me dire un mot de passe incorrect. Et le code a disparu. .
Ce commentaire a été minimisé par le modérateur sur le site
Merhaba Tablo ismini ve satır başlangıc yerlerini değiştirdiğim zaman kod çalışmıyor yardımcı olurmusunuz
Ce commentaire a été minimisé par le modérateur sur le site
Hi,
Assurez-vous que vous avez modifié exactement le même nom de table et le même en-tête de colonne dans le code.
J'ai changé le nom de la table et l'en-tête de colonne pour tester le code, et cela fonctionne bien.
Avez-vous reçu une invite d'erreur ? J'ai besoin d'en savoir plus sur votre problème, comme votre version d'Excel. Plus vous décrivez l'erreur en détail, plus vite nous pourrons la comprendre et la résoudre.
Ce commentaire a été minimisé par le modérateur sur le site
Comment créer un bouton pour effacer des lignes ?
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour!
Tengo una tabla donde más de una columna está protegida.
La tabla tiene 17 colonnes de las cuales 7 deben quedar bloqueadas porque poseen fórmulas.
Mi tabla arranca en celda A4

Estaba tratando de usar este código para probarlo, cambiando lo que verán abajo como "CLAVE", "MITABLA" y "AVISO 1" por mis numbers particulares :
Donde "AVISO 1" correspond à une des colonnes qui est protégée.

Dim pswStr As String
'Mettre à jour par ExtendOffice 20181106
pswStr = "CLAVE"
On Error Resume Next
Application.ScreenUpdating = Faux
ActiveSheet.Unprotect Password :=pswStr
ActiveSheet.Range("A4").Sélectionner
Range("MITABLA[[#Headers],[AVISO 1]]").Select
Selection.End (xlDown) .Sélectionnez
Sélection.Décalage(1, -16).Sélectionner
ActiveCell.FormulaR1C1 = "nouveau"
Mot de passe ActiveSheet.Protect :=pswStr, DrawingObjects :=False, _
Contenu :=Vrai, Scénarios :=Faux, _
AllowFormattingCells :=Vrai, AllowFormattingColumns :=Vrai, _
AllowFormattingRows :=Vrai, AllowInsertingColumns :=Vrai, _
AllowInsertingRows :=Vrai, AllowInsertingHyperlinks :=Vrai, _
AllowDeletingColumns :=Vrai, AllowDeletingRows :=Vrai, _
AllowSorting :=Vrai, AllowFiltering :=Vrai, _
AllowUsingPivotTables : = vrai
Selection.ClearContents
Application.ScreenUpdating = True

Lo que está haciendo el código tal cual como lo escribo es que en lugar de agregar una nueva línea a mi tabla, está colocando la palabra "new" en la última celda con tenido de la columna "AVISO 1".

Surgen entonne 2 dudas :
1. ¿cómo podría hacer para determinar más de una columna protegida ?
2. ¿por qué está haciendo esto el código definido?

Agradezco de antemano que me puedan ayudar ! Estaré atenta.
Ce commentaire a été minimisé par le modérateur sur le site
Salut Daina,
1. Si les 7 colonnes de formules que vous souhaitez protéger sont consécutives dans le tableau.
Par exemple, les en-têtes des colonnes sont gg, hh, ii, jj, kk, ll, mm comme indiqué dans la capture d'écran ci-dessous. Vous pouvez appliquer le code VBA suivant pour le faire.
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/table.png
Dans cette ligne Set xRg = Range("Table3[[#Headers],[gg]:[mm]]").Offset(1, 0) dans le code suivant, il vous suffit de saisir les en-têtes de la première colonne et de la dernière colonne.
Sub Button1_Click()
 'Update by ExtendOffice 20220826
    Dim xRg, tableRg As Range
    Dim xRowCount As Integer
    Dim pswStr As String
    pswStr = "123"
    On Error Resume Next
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:=pswStr

    'Change the table name and the column headers
    Set tableRg = ActiveSheet.ListObjects("Table3").Range
    xRowCount = tableRg.Rows.Count
    
     Set xRg = Range("Table3[[#Headers],[gg]:[mm]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, xRg.Columns.Count)

    xRg.Resize(xRowCount - 1, xRg.Columns.Count).AutoFill Destination:=yRg, Type:=xlFillDefault
    

    ActiveSheet.Protect Password:=pswStr, DrawingObjects:=False, _
                    Contents:=True, Scenarios:=False, _
                    AllowFormattingCells:=True, AllowFormattingColumns:=True, _
                    AllowFormattingRows:=True, AllowInsertingColumns:=True, _
                    AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _
                    AllowDeletingColumns:=True, AllowDeletingRows:=True, _
                    AllowSorting:=True, AllowFiltering:=True, _
                    AllowUsingPivotTables:=True
    Application.ScreenUpdating = True
End Sub

2. Si les 7 colonnes de formules que vous souhaitez protéger sont discontinues dans le tableau. Appliquez le code suivant. Dans le code, vous devez saisir manuellement les en-têtes des colonnes un par un.
Sub Button1_Click()
 'Update by ExtendOffice 20220826
    Dim xRg, tableRg As Range
    Dim xRowCount As Integer
    Dim pswStr As String
    pswStr = "123"
    On Error Resume Next
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:=pswStr

    'Change the table name and the column headers
    Set tableRg = ActiveSheet.ListObjects("Table3").Range
    xRowCount = tableRg.Rows.Count
    
    Set xRg = Range("Table3[[#Headers],[gg]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault
    Set xRg = Range("Table3[[#Headers],[hh]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault
    Set xRg = Range("Table3[[#Headers],[ii]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault
    Set xRg = Range("Table3[[#Headers],[jj]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault
    Set xRg = Range("Table3[[#Headers],[kk]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault
     Set xRg = Range("Table3[[#Headers],[ll]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault
    Set xRg = Range("Table3[[#Headers],[mm]]").Offset(1, 0)
    Set yRg = xRg.Resize(xRowCount, 1)
    xRg.Resize(xRowCount - 1, 1).AutoFill Destination:=yRg, Type:=xlFillDefault

    ActiveSheet.Protect Password:=pswStr, DrawingObjects:=False, _
                    Contents:=True, Scenarios:=False, _
                    AllowFormattingCells:=True, AllowFormattingColumns:=True, _
                    AllowFormattingRows:=True, AllowInsertingColumns:=True, _
                    AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _
                    AllowDeletingColumns:=True, AllowDeletingRows:=True, _
                    AllowSorting:=True, AllowFiltering:=True, _
                    AllowUsingPivotTables:=True
    Application.ScreenUpdating = True
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Salut.

Merci d'avoir partagé. Bien que j'aie une question... en utilisant le code ci-dessus, je peux ajouter une ligne à la fois. Comment ajouter plusieurs lignes en un clic ?

Merci d'avance.

'Mettre à jour par ExtendOffice 20220826
Dim xRg, tableRg As Range
Dim xRowCount As Integer
Dim pswStr As String
pswStr = "123"
On Error Resume Next
Application.ScreenUpdating = Faux
ActiveSheet.Unprotect Password :=pswStr

Set tableRg = ActiveSheet.ListObjects("Table4").Range
xRowCount = tableRg.Rows.Count

Set xRg = Range("Table4[[#Headers],[Total]]").Offset(1, 0)
Définir yRg = xRg.Resize(xRowCount, 1)
xRg.Resize(xRowCount - 1, 1).AutoFill Destination :=yRg, Type :=xlFillDefault

Mot de passe ActiveSheet.Protect :=pswStr, DrawingObjects :=False, _
Contenu :=Vrai, Scénarios :=Faux, _
AllowFormattingCells :=Vrai, AllowFormattingColumns :=Vrai, _
AllowFormattingRows :=Vrai, AllowInsertingColumns :=Vrai, _
AllowInsertingRows :=Vrai, AllowInsertingHyperlinks :=Vrai, _
AllowDeletingColumns :=Vrai, AllowDeletingRows :=Vrai, _
AllowSorting :=Vrai, AllowFiltering :=Vrai, _
AllowUsingPivotTables : = vrai
Application.ScreenUpdating = True
Ce commentaire a été minimisé par le modérateur sur le site
Le code ne fonctionne pas.
Plusieurs erreurs.

Dim xRg, tableRg As Range

xRg
est une variante pas une gamme

yRg
pas déclaré du tout

Set xRg = Range("Table4[[#Headers],[Total]]").Offset(1, 0)

erreur d'exécution 1004
Quand j'enlève le TOTAL, ça marche.
Cela ne fonctionne pas avec la ligne totale affichée et non plus lorsque je masque la ligne totale dans le ruban.

Normalement, votre site Web est vraiment génial, mais cet article doit être amélioré.
Ce commentaire a été minimisé par le modérateur sur le site
Salut Prem,
Vous devez vous assurer que le nom de table et l'en-tête de colonne spécifiés dans le code correspondent au nom de table et à l'en-tête de colonne dans la feuille de calcul. Pour éviter l'erreur 1004, vous devrez peut-être activer le faire confiance à l'accès au modèle d'objet du projet VBA dans votre Excel : cliquez sur Déposez le > Options > Trust Center > Paramètres du Centre > Paramètres de macro > puis vérifiez le Autoriser l'accès au modèle d'objet de projet VBA boîte.
Ce commentaire a été minimisé par le modérateur sur le site
Sous ButtonOut_Click()

Dim PswS en tant que chaîne
PswStr = "54321"

On Error Resume Next

Application.ScreenUpdating = Faux
ActiveSheet.Unprotect Password :=PswStr

ActiveSheet.ListObjects("Table1").ListRows.Add

Mot de passe ActiveSheet.Protect :=PswStr
Application.ScreenUpdating = True

End Sub
Il n'y a pas encore de commentaires postés ici
Laisser vos commentaires
Publier en tant qu'invité
×
Évaluez cet article:
0   Personnages
Emplacements suggérés