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

كيف تحافظ على الجدول قابل للتوسيع عن طريق إدراج صف الجدول في ورقة عمل محمية في إكسيل؟

ستفقد وظيفة التوسيع التلقائي للجدول بعد حماية ورقة العمل في Excel. على سبيل المثال ، يوجد جدول يسمى Table1 في ورقة العمل المحمية الخاصة بك ، عندما تكتب أي شيء أسفل الصف الأخير ، لن يتم توسيع الجدول تلقائيًا ليشمل الصف الجديد. هل هناك طريقة لإبقاء الجدول قابلاً للتوسيع بإدراج صف جديد في ورقة عمل محمية؟ يمكن أن تساعدك الطريقة في هذه المقالة على تحقيق ذلك.

حافظ على الجدول قابلاً للتوسيع عن طريق إدراج صف الجدول في ورقة عمل محمية برمز VBA


حافظ على الجدول قابلاً للتوسيع عن طريق إدراج صف الجدول في ورقة عمل محمية برمز VBA

كما هو موضح أدناه ، يوجد جدول يسمى Table1 في ورقة العمل الخاصة بك ، والعمود الأخير من الجدول هو عمود الصيغة. أنت الآن بحاجة إلى حماية ورقة العمل لمنع تغيير عمود الصيغة ، مع السماح بتوسيع الجدول عن طريق إدراج صف جديد وتعيين بيانات جديدة في الخلايا الجديدة. الرجاء القيام بما يلي.

1. انقر المطور > إدراج > زر (التحكم في النموذج) لإدراج أ التحكم بالنموذج زر في ورقة العمل الخاصة بك.

2. في ظهرت تعيين ماكرو مربع الحوار، انقر فوق جديد .

3. في ال ميكروسوفت فيسوال باسيك للتطبيقات نافذة ، يرجى نسخ ولصق رمز VBA أدناه بين ملف فرعية و نهاية الفرعية الفقرات في رمز نافذة.

كود فبا: حافظ على الجدول قابل للتوسيع عن طريق إدراج صف الجدول في ورقة عمل محمية

 '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

ملاحظة:

1). في الكود ، الرقم "123" هو كلمة المرور التي ستستخدمها لحماية ورقة العمل.
2). الرجاء تغيير اسم الجدول واسم العمود الذي يحتوي على الصيغة التي ستحميها.

4. اضغط على قديم + Q مفاتيح لإغلاق نافذة ميكروسوفت فيسوال باسيك للتطبيقات.

5. حدد الخلايا في الجدول التي تريد تعيين بيانات جديدة إليها باستثناء عمود الصيغة ، ثم اضغط على CTRL + 1 مفاتيح لفتح تنسيق الخلايا صندوق المحادثة. في ال تنسيق الخلايا مربع الحوار ، قم بإلغاء تحديد مقفل مربع ، ثم انقر فوق OK زر. انظر لقطة الشاشة:

6. الآن قم بحماية ورقة العمل الخاصة بك بكلمة المرور التي حددتها في رمز VBA.

من الآن فصاعدًا ، بعد النقر فوق الزر "التحكم في النموذج" في ورقة العمل المحمية ، سيكون الجدول قابلاً للتوسيع عن طريق إدراج صف جديد كما هو موضح أدناه.

ملاحظة: يمكنك تعديل الجدول باستثناء عمود الصيغة في ورقة العمل المحمية.


مقالات ذات صلة:


أفضل أدوات إنتاجية المكتب

Kutools for Excel يحل معظم مشاكلك ويزيد إنتاجيتك بنسبة 80٪

  • إعادة استخدام: أدخل بسرعة الصيغ المعقدة والرسوم البيانية وأي شيء استخدمته من قبل ؛ تشفير الخلايا مع كلمة السر إنشاء قائمة بريدية وإرسال رسائل البريد الإلكتروني ...
  • سوبر فورميولا بار (بسهولة تحرير أسطر متعددة من النص والصيغة) ؛ تخطيط القراءة (قراءة وتحرير أعداد كبيرة من الخلايا بسهولة) ؛ لصق في النطاق المصفى
  • دمج الخلايا / الصفوف / الأعمدة دون فقدان البيانات ؛ تقسيم محتوى الخلايا ؛ ادمج الصفوف / الأعمدة المكررة... منع تكرار الخلايا؛ قارن النطاقات
  • حدد مكرر أو فريد صفوف حدد صفوف فارغة (جميع الخلايا فارغة) ؛ البحث الفائق والبحث الغامض في العديد من المصنفات. تحديد عشوائي ...
  • نسخة طبق الأصل خلايا متعددة بدون تغيير مرجع الصيغة ؛ إنشاء المراجع تلقائيًا إلى أوراق متعددة أدخل الرموز النقطية، مربعات الاختيار والمزيد ...
  • استخراج النص، إضافة نص ، إزالة حسب الموضع ، إزالة الفضاء؛ إنشاء وطباعة المجاميع الفرعية لترحيل الصفحات ؛ التحويل بين محتوى الخلايا والتعليقات
  • سوبر تصفية (حفظ وتطبيق مخططات التصفية على أوراق أخرى) ؛ فرز متقدم حسب الشهر / الأسبوع / اليوم ، التكرار والمزيد ؛ مرشح خاص بواسطة bold، italic ...
  • اجمع بين المصنفات وأوراق العمل؛ دمج الجداول على أساس الأعمدة الرئيسية ؛ تقسيم البيانات إلى أوراق متعددة; تحويل دفعة xls و xlsx و PDF
  • أكثر من 300 ميزة قوية. يدعم Office / Excel 2007-2021 و 365. يدعم جميع اللغات. سهولة النشر في مؤسستك أو مؤسستك. الميزات الكاملة نسخة تجريبية مجانية لمدة 30 يومًا. ضمان استرداد الأموال لمدة 60 يومًا.
علامة تبويب kte 201905

يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير

  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!
أوفيسيتاب القاع
فرز التعليقات حسب
التعليقات (18)
لا يوجد تقييم. كن أول من يقيم!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
لذلك جربت هذا ولكنه يضيف صفًا جديدًا في أسفل المصنف في السطر 1048576 ومع ذلك يحتوي الجدول الخاص بي على حوالي 800 سجل فقط. ليس لدي أي فكرة عن سبب قيامها بذلك!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا بريندي ،
تم تحديث الكود مع حل المشكلة ، يرجى المحاولة وشكرا لتعليقك.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا كريستال ، المشكلة هي نفسها. لقد أنشأت جدولًا جديدًا لنفسي من صفين فقط. بمجرد النقر فوق الزر ، يتم توسيع القائمة حتى نهاية الجدول دون إضافة أي صفوف. يجب أن يتم الإضافة إلى الصف رقم 2.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا كريستال ، المشكلة هي نفسها. لقد أنشأت جدولًا جديدًا لنفسي من صفين فقط. بمجرد النقر فوق الزر ، يتم توسيع القائمة حتى نهاية الجدول دون إضافة أي صفوف. يجب أن يتم الإضافة إلى الصف رقم 2.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
جرب رمز Vba هذا لإضافة سطر جديد في جدولك

إضافة علامة تبويب فرعية ()
خافت pswStr كسلسلة
pswStr = "123"
على خطأ استئناف التالي
Application.ScreenUpdating = خطأ
ActiveSheet.Unprotect Password: = pswStr
ActiveSheet.Range ("D8"). حدد
"D8 هو رأس الجدول
النطاق ("جدول 1 [[# رؤوس] ، [إجمالي]]"). حدد
Selection.End (xlDown) .Select
Selection.ListObject.ListRows.Add AlwaysInsert: = False
ActiveSheet.Protect Password: = pswStr

نهاية الفرعية
.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ماك ،
شكرا على المشاركة.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
باستخدام الخيار المقترح (Selection.ListObject.ListRows.Add AlwaysInsert: = False) ، تم إصلاح مشكلة مماثلة بالنسبة لي مع الكود الأصلي ، حيث لن يتم إضافة صف كامل جديد (يمتد إلى أسفل الخلية تحتوي على الصيغ) إلى الجدول على نطاق أوسع بكثير جدول 51 أعمدة. لذا نشكرك على مشاركة Mac وإصلاحه.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، لقد استخدمت الرمز أعلاه وتلقيت رسالة الخطأ التالية:
"توقف تنفيذ التعليمات البرمجية". عند النقر فوق Debug ، يتم تمييز السطر 20 "Selection.ClearContents".

عندما أدخلت الرمز في البداية ، كان يعمل بشكل صحيح.

لقد غيرت "جدول" إلى اسم الجدول وغيرت العمود إلى اسم العمود الذي أستخدمه. لقد غيرت أيضًا "Selection.Offset (x، -x) .Select" لتلائم احتياجاتي.


أي اقتراحات لماذا يحدث هذا؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا،

عمل الكود في البداية ، ولكن بعد أن قمت بتكرار ورقة العمل ، بقيت لمدة 24 ساعة ثم اختفى كل الرمز. والآن لا يمكنني الوصول إلى ورقة العمل.

يستمر في إخباري بكلمة مرور غير صحيحة. واختفى الرمز. .
تم تصغير هذا التعليق بواسطة المشرف على الموقع
Merhaba Tablo ismini ve satır başlangıc yerlerini değiştirdiğim zaman kod çalışmıyor yardımcı olurmusunuz
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا،
تأكد من أنك قمت بالتغيير إلى نفس اسم الجدول بالضبط ورأس العمود في الكود.
لقد قمت بتغيير اسم الجدول ورأس العمود لاختبار الكود ، وهو يعمل بشكل جيد.
هل تلقيت أي خطأ موجه؟ أحتاج إلى معرفة أكثر تحديدًا حول مشكلتك ، مثل إصدار Excel الخاص بك. كلما وصفت الخطأ بالتفصيل ، زادت سرعتنا في فهمه وحلّه.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
كيف أقوم بإنشاء زر لمحو الخطوط؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا!
Tengo una tabla donde más de una columna está protegida.
La tabla tiene 17 عمودًا من las cuales 7 deben quedar bloqueadas porque poseen fórmulas.
مي تابلا رانيكا اون سيلدا A4

Estaba tratando de usar este código para probarlo، cambiando lo que verán abajo como "CLAVE"، "MITABLA" y "AVISO 1" من خلال الأسماء الخاطئة:
يتوافق Donde "AVISO 1" مع أعمدة قائمة بذاتها.

خافت pswStr كسلسلة
'تحديث بواسطة ExtendOffice 20181106
pswStr = "CLAVE"
على خطأ استئناف التالي
Application.ScreenUpdating = خطأ
ActiveSheet.Unprotect Password: = pswStr
ActiveSheet.Range ("A4"). حدد
النطاق ("MITABLA [[# Headers] ، [AVISO 1]]"). حدد
Selection.End (xlDown) .Select
التحديد. الإزاحة (1 ، -16)
ActiveCell.FormulaR1C1 = "جديد"
ActiveSheet.Protect Password: = pswStr ، DrawingObjects: = False ، _
المحتويات: = صحيح ، السيناريوهات: = خطأ ، _
AllowFormattingCells: = صحيح ، AllowFormattingColumns: = صحيح ، _
AllowFormattingRows: = صحيح ، AllowInsertingColumns: = صحيح ، _
AllowInsertingRows: = صحيح ، AllowInsertingHyperlinks: = صحيح ، _
AllowDeletingColumns: = صحيح ، AllowDeletingRows: = صحيح ، _
AllowSorting: = صحيح ، AllowFiltering: = صحيح ، _
AllowUsingPivotTables: = صحيح
اختيار محتويات واضحة
Application.ScreenUpdating = ترو

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

سورجين يدخل 2 دودة:
1. ؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟
2. ¿por qué está haciendo esto el código Definido؟

Agradezco de Antemano que me puedan ayudar! Estaré atenta.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا دينا ،
1. إذا كانت أعمدة الصيغة السبعة التي تريد حمايتها متتالية في الجدول.
على سبيل المثال ، رؤوس الأعمدة هي gg و hh و ii و jj و kk و ll و mm كما هو موضح في لقطة الشاشة أدناه. يمكنك تطبيق كود فبا التالي لإنجازه.
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/table.png
في هذا الخط اضبط xRg = Range ("Table3 [[# Headers] ، [gg]: [mm]]"). الإزاحة (1 ، 0) في الكود التالي ، ما عليك سوى إدخال رؤوس العمود الأول والعمود الأخير.
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. إذا كانت أعمدة الصيغة السبعة التي تريد حمايتها غير متصلة في الجدول. قم بتطبيق الكود التالي. في الكود ، تحتاج إلى إدخال رؤوس الأعمدة يدويًا واحدًا تلو الآخر.
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
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا.

شكرا للمشاركة. على الرغم من أن لدي سؤال ... باستخدام الكود أعلاه ، يمكنني إضافة صف واحد في كل مرة. كيف تضيف عدة صفوف بنقرة واحدة؟

شكرا مقدما.

'تحديث بواسطة ExtendOffice 20220826
Dim xRg ، tableRg كنطاق
خافت xRowCount كعدد صحيح
خافت pswStr كسلسلة
pswStr = "123"
على خطأ استئناف التالي
Application.ScreenUpdating = خطأ
ActiveSheet.Unprotect Password: = pswStr

تعيين tableRg = ActiveSheet.ListObjects ("Table4"). النطاق
xRowCount = tableRg.Rows.Count

قم بتعيين xRg = Range ("Table4 [[# Headers]، [Total]]"). الإزاحة (1 ، 0)
اضبط yRg = xRg.Resize (xRowCount، 1)
xRg.Resize (xRowCount - 1، 1). وجهة الملء التلقائي: = yRg ، النوع: = xlFillDefault

ActiveSheet.Protect Password: = pswStr ، DrawingObjects: = False ، _
المحتويات: = صحيح ، السيناريوهات: = خطأ ، _
AllowFormattingCells: = صحيح ، AllowFormattingColumns: = صحيح ، _
AllowFormattingRows: = صحيح ، AllowInsertingColumns: = صحيح ، _
AllowInsertingRows: = صحيح ، AllowInsertingHyperlinks: = صحيح ، _
AllowDeletingColumns: = صحيح ، AllowDeletingRows: = صحيح ، _
AllowSorting: = صحيح ، AllowFiltering: = صحيح ، _
AllowUsingPivotTables: = صحيح
Application.ScreenUpdating = ترو
تم تصغير هذا التعليق بواسطة المشرف على الموقع
الرمز لا يعمل.
عدة أخطاء.

Dim xRg, tableRg As Range

xRg
هو متغير وليس نطاق

yRg
لم يعلن على الإطلاق

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

خطأ وقت التشغيل 1004
عندما أقوم بإزالة TOTAL ، فإنه يعمل.
إنه لا يعمل مع عرض الصف الإجمالي ولا عندما أخفي الصف الإجمالي في الشريط.

عادةً ما يكون موقع الويب الخاص بك رائعًا حقًا ، لكن هذه المقالة بحاجة إلى تحسين.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا بريم ،
تحتاج إلى التأكد من تطابق اسم الجدول ورأس العمود المحددين في الكود مع اسم الجدول ورأس العمود في ورقة العمل. لتجنب الخطأ 1004 ، قد تحتاج إلى تمكين الثقة في الوصول إلى نموذج كائن مشروع VBA في Excel الخاص بك: انقر فوق قم بتقديم > العلاج > مركز التوثيق > إعدادات مركز التوثيق > إعدادات الماكرو > ثم تحقق من ملف الثقة بالوصول إلى نموذج كائن مشروع فبا مربع.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
زر فرعيOut_Click ()

خافت PswS كسلسلة
PswStr = "54321"

على خطأ استئناف التالي

Application.ScreenUpdating = خطأ
ActiveSheet.Unprotect Password: = PswStr

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

ActiveSheet.Protect Password: = PswStr
Application.ScreenUpdating = ترو

نهاية الفرعية
لا توجد تعليقات منشورة هنا حتى الآن
اترك تعليقاتك
النشر كضيف
×
قيم المنشور:
0   الشخصيات
المواقع المقترحة

تواصل معنا

حقوق التأليف والنشر © 2009 - شبكة الاتصالات العالمية.extendoffice.com. | كل الحقوق محفوظة. مشغل بواسطة ExtendOffice. | | خريطة الموقع
Microsoft وشعار Office هما علامتان تجاريتان أو علامتان تجاريتان مسجلتان لشركة Microsoft Corporation في الولايات المتحدة و / أو دول أخرى.
محمي بواسطة Sectigo SSL