أ / محمد صالح

هل هذا بعد تنفيذ الحلين الموجودين في المشاركات؟ الحل الأول الحل الثاني

حسب فهمي للمطلوب يمكنك إضافة هذا الشرط لحدث عن تغير التحديد If Target.Column > 6 And Target.Column < 14 And Target.Row > 2 Then For Each c In Range("f" & Target.Row & ":m" & Target.Row) If Not c.Locked Then MsgBox "يرجى إنهاء أعمال " & Cells(1, c.Column) & " أولا": Exit For Next c End If للعلم يتم جلب قيمة الصف الأول في العمود المسموح بتعديله قبل كلمة أولا بالتوفيق

بعد فحص ملفك المشكلة ليست في كود الترحيل المشكلة في كود عرض الوقت على النموذج جرب هذا الكود في حدث تنشيط النموذج Private Sub UserForm_Activate() VBA.Calendar = vbCalHijri L2.Caption = "التاريخ الهجرى :" & Format(Date, "ddd dd mmm yyyy") VBA.Calendar = vbCalGreg L1.Caption = "التاريخ :" & Format(Date, "ddd dd mmm yyyy") Do L3.Caption = Format(Now, "hh:nn:ss AM/PM") DoEvents Loop End Sub بالتوفيق

ربما يوجد وظيفة إضافية add-in لها هذا التأثير لمعرفة addins من تبويب file ثم options وربما يكون السبب برنامج تسجيل الشاشة الذي تستخدمه الاحتمالات كثيرة

لقد غيرت نوع التقويم في اكسل الي هجري بهذا السطر ولإعادة التقويم للميلادي نستخدم هذا السطر VBA.Calendar = vbCalGreg بالتوفيق

يبدو أن حضرتك لم تقرأ هذا من قبل يجب وضع وصف دقيق ومفصل للمشكلة (تم تعديل الموضوع وإضافة الشرح الموجود بالملف) على العموم هذا ملفك بعد التعديل بملاحظة الجداول وجدت أسماءها الجدول20 والجدول21 وهكذا فتم استعمال اسم الجدول في معادلة البحث بالتوفيق بحث فى عدة جداول برقم.xlsx

جميعا بإذن الله تجده في الرابط الموجود في مشاركتي السابقة البرنامج بسيط ولا يحتاج لشرح ومن المؤكد لو بحثت عنه في يوتيوب أن تجد شروحات كثيرة

أنا شخصيا رأيت في xampp مشكلات كثيرة مما جعلني أستعمل Unform Server منذ أكثر من عشرة أعوام بالتوفيق

يا ريت توضح اكتر هل تقصد عند الضغط بالزر الأيمن الفأرة على خلية تظهر القائمة المختصرة للخلية وتختفي بسرعة أم ماذا ؟ ويفضل ارفاق الملف الذي تحدث به هذه المشكلة فربما يكون هذا بفعل كود من اكواد الملف

الفكرة في تغيير النطاق الذي سيتم وضع المعادلة له ثم تحويله إلى قيمة مثلا من b6:b1000 With Range("b6:b1000") .Formula = "=iferror(INDEX('1.xlsx'!$C:$C,MATCH(A6,'1.xlsx'!$A:$A,0)),"""")" .Value = .Value End With تم وضع دالة iferror بالتوفيق

المشكلة في ملفك أنها نطاقات متباعدة لو كانت كتلة واحدة من الصف مثلا 5 الى الصف 1000 سيتم كتابة المعادلة مرة واحدة ومعها القيمة في with واحدة لكن ملفك كل صفين مجموعة ثم مجموعها

يمكنك استعمال هذا الاجراء Sub mas_getvalues() With Range("b6:b7") .Formula = "=INDEX('1.xlsx'!$C:$C,MATCH(A6,'1.xlsx'!$A:$A,0))" .Value = .Value End With With Range("b10:b12") .Formula = "=INDEX('1.xlsx'!$C:$C,MATCH(A10,'1.xlsx'!$A:$A,0))" .Value = .Value End With With Range("b15:b16") .Formula = "=INDEX('1.xlsx'!$C:$C,MATCH(A15,'1.xlsx'!$A:$A,0))" .Value = .Value End With With Range("c6:c7") .Formula = "=INDEX('2.xlsx'!$D:$D,MATCH(A6,'2.xlsx'!$A:$A,0))" .Value = .Value End With With Range("c10:c12") .Formula = "=INDEX('2.xlsx'!$D:$D,MATCH(A10,'2.xlsx'!$A:$A,0))" .Value = .Value End With With Range("c15:c16") .Formula = "=INDEX('2.xlsx'!$D:$D,MATCH(A15,'2.xlsx'!$A:$A,0))" .Value = .Value End With وربطه بشكل أو زر ولا تنس حفظ الملف بامتداد مثل xlsb أو xlsm

ممكن بس فين رمز كنترول الصواب Application.SendKeys("^z") ولكن تذكر أن هذا السطر يساوي Application.undo وهما معا يقومان بالتراجع خطوة واحدة قبل تنفيذ الكود vba

يمكنك استعمال هذا الإجراء Sub clr_with_pw() If InputBox("من فضلك أدخل كلمة المرور.", "حماية") = "1234" Then Range("A2:D15").ClearContents Range("A2").Select Else: MsgBox "كلمة المرور خطأ": End If End Sub حيث أن كلمة المرور لتنفيذ هذا الإجراء هي 1234 ويمكن استعمال ذلك الكود مع أي ماكرو بوضع اكواد الماكرو مكان السطرين الثالث والرابع وتغيير 1234 إلى كلمة المرور المطلوبة بالتوفيق

يا ريت توضح اكثر .... هل تقصد عند الضغط على زر معين يطلب من المستخدم إدخال كلمة مرور فإذا كانت صحيحة يتم تنفيذ الأكواد المخصصة للزر وإلا فلا ينفذ ؟؟؟؟

الترحيل كود vba

يبدو أن حضرتك لم تقرأهذا الجزء

كود التراجع عن آخر حركة واحدة قام بها المستخدم هو Application.undo وفي حالة التراجع عن أكثر من خطوة يفضل استعمال ctrl+z أو من شريط الوصول السريع QAT ******* أما إذا كان المقصود الرجوع إلى إصدار سابق من الملف قبل إجراء أية تعديلات فيمكن عن طريق تفعيل version history من تبويب file ثم info و رفع الملف في حساب OneDrive بالتوفيق

ينفع طالما لم يتم إغلاق الملف أو لم يتم تنفيذ كود vba على الملف

من أساسيات التعامل مع vba عدم تسمية الدالة function بنفس اسم الموديول module يمكنك حل هذه المشكلة بإعادة تسمية الدوال أو اضافة اللاحقة _mod في نهاية اسم الموديول من خلال نافذة الخصائص أسفل يسار نافة محرر الأكواد بالتوفيق

في مثل هذه الحالات نستعمل دالة sumif أو sumifs

بعد إذن أخي الكريم @عبدالفتاح في بي اكسيل كانت لي محاولة في هذا الشأن منذ عام 2011 في الأكسس فقمت بتطويع الكود للعمل مع نماذج الاكسل فقط يتم تحديد أفضل عرض bestw وأفضل ارتفاع besth في الكود في حدث UserForm_Initialize وهما دقة الشاشة التي تم التصميم عليها بالتوفيق resizeform.xlsb

للأسف لا يوجد طريقة نسخة الاكسل للموبايل محدودة الإمكانيات وتفتقد الكثير من المميزات من ضمنها بعض المعادلات وإضافة أكواد vba أو عناصر activeX لأن هذه الأشياء تعتمد على نظام التشغيل ويندوز وربما في المستقبل القريب يتم التوصل لمحاكي ومترجم لاكواد vb في الاندرويد بالتوفيق

جرب هذا الكود لزر الترحيل فقط Private Sub CommandButton3_Click() Dim rng1 As Range Dim str_search As String str_search = Txt2.Value Set rng1 = sheets("SHEET1").Range("E:E").Find(str_search, , xlValues, xlWhole) If Not rng1 Is Nothing Then Application.ScreenUpdating = False Dim row_number As Long row_number = rng1.Row lastColumn = IIf(Sheets("SHEET1").Range("t" & row_number) = "", 20, Sheets("SHEET1").Range("t" & row_number).End(xlToRight).Column + 1) sheets("SHEET1").Cells(row_number, lastColumn).Value = Txt4.Value sheets("SHEET1").Cells(row_number, lastColumn + 1).Value = Txt7.Value sheets("SHEET1").Select Cells(row_number, lastColumn).Select Me.Hide Application.ScreenUpdating = True End If MsgBox "تم ترحيل المبلغ والتاريخ" End Sub بالتوفيق

يمكنك اخفاء ورقة العمل بدون كود كلك يمين على اسم الشيت ثم اخفاء hide ولو بالكود Sheets("sheet name").visible = False مع تغيير اسم الشيت المطلوب مكان sheet name بالتوفيق