عبدالسلام ابوالعوافي

اعتقد سبب الرسالة هو تعديل في السجل من اكثر من مستخدم في نفس الوقت .. هل قاعدة البيانات Shared ؟

هل تقصد عدد النسخ ؟

اخي الكريم .. ماقلته لك هو تشخيص المشكلة وليست الحل .. لاني لم اراجع الكود بالكامل ..الان قمت بمراجعة الكود وقمت بازالة بعض الاكواد واتمنى ان يكون هذا ماتريد Sub Button2_Click() Application.ScreenUpdating = False For I = 8 To 32 If Cells(I, 3).Value = "" Then Cells(I, 3).EntireRow.Hidden = True End If Next I ActiveSheet.PrintPreview If MsgBox("هل تود الطباعة بعد المعاينة؟", vbYesNo + vbQuestion, "طباعة") = vbYes Then ActiveSheet.PrintOut Rows.Hidden = False Application.ScreenUpdating = True End Sub

فقط انسخ المعادلة والصقها في الخلية B2 واسحب لاسفل .. كما في الصورة

حدد جميع الخلايا ... اضغط F2 .. كنترول + انتر

ماتقوم به الداله هو الصحيح لغويا

Application.ScreenUpdating = False ActiveSheet.Unprotect Password:="123456" For Each ce In Range("D6:E1000") ce.MergeArea.Locked = "True" Next ce ActiveSheet.Protect Password:="123456", Contents:=True, AllowFormattingCells:=True, _ AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingColumns:=True, _ AllowInsertingRows:=True, AllowDeletingColumns:=True, AllowDeletingRows:=True Application.ScreenUpdating = True

هناك امران للطباعة .. الرسالة تلغي الامر الاول .. لكن الامر الثاني غير مرتبط بالرسالة

قم بحذف المعادلات في العمود BF وجرب هذا الكود Dim i As Integer For i = 6 To 1000 If Cells(i, "f") > 0 Then Cells(i, "bf") = Cells(i, "f") Else Cells(i, "bf") = 1 End If Next

=HYPERLINK(RIGHT("0000"&ROW()-1;4)&".pdf") تضع المعادلة في الصف الثاني وتقوم بسحبها للاخر

ActiveSheet.Range("BF6:BF1000").FormulaArray = _ "=IF(RC[-52]:R[994]C[-52]="""","""",IF(RC[-52]:R[994]C[-52]>=0,RC[-52]:R[994]C[-52],1))"

اخي الفاضل .. الكود لا يوجد بيه End if .. احذف السطر

ActiveSheet.Range("BF6:BF1000").FormulaArray = "=IF(RC[-52]:R[994]C[-52]>=0,RC[-52]:R[994]C[-52],1)"

ActiveSheet.Range("E6:E1000").FormulaArray = "=IF(RC[-1]:R[994]C[-1]>=0,RC[-1]:R[994]C[-1],1)"

السلام عليكم المرفق يمنع الطباعة الا عن طريق الكود .. اضف كود الطباعة فيه وجرب بالنسبة لاخفاء التبويبات .. يجب اخفاء التبويب والخيارات وشريط المهام السريع QAT لمنع المستخدم من ارجاع التبويب http://www.rondebruin.nl/win/s2/win001.htm هذا الموقع قد يفيدك Prevent Print.rar

استاذنا ياسر .. لم اقصد ايجاد حل للسؤال بقدر ما اردت اضفاء جو من المرح والتحدي .. احببت المشاركة بكود اقصر مايكون ويؤدي الغرض .. لان التحدي في قصر الكود .. ولو كان التحدي في الاحترافية لاستخدمنا error handler واكود التسريع كما تفضلت .. اتمنى ان يفهم كلامي كما قصدت .. تقبل مروري استاذنا الفاضل

السلام عليكم اسمحو لي بالمشاركة .. واسمح لي استاذنا ياسر ان اقول ان كود حضرتك طويل ايضا .. جرب Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range Range("c6:n6").EntireColumn.Hidden = True For Each rng In Range("c6:n6") If rng = [b6] Then rng.EntireColumn.Hidden = False Next End Sub في انتظار كود اقصر .. تقبلو تحياتي

=INDIRECT("Sheet1!B7")

Private Sub Form_BeforeUpdate(Cancel As Integer) 'user ' userTable 'fullname ' userNmae On Error GoTo ErrorBakry If Me.NewRecord Then Me.CreatedBy = DLookup("fullname", "users") Me.CreatedDate = Now() ElseIf Me.Dirty = True Then Me.ModifiedBy = DLookup("fullname", "users") Me.ModifiedDate = Now() Exit Sub ErrorBakry: MsgBox "حدث خطأ ما ", vbOKOnly + vbCritical + vbMsgBoxRight, "تنبيه" Resume Next End If End Sub لست متاكد .. لانك لم ترفع الملف للتجربة ..

الكود صحيح اخي الفاضل .. لكن يجب التعديل علي زر الدخول في الفورم 3 Unload Me User_Data.Show بدلا من User_Data.Show Unload Me

Private Sub CommandButton4_Click() Unload Me Application.Visible = True Sheets("s").Select End Sub

السلام عليكم كما اسلف الاخوة بان الترحيل صعب ويحتاج الى وقت وليس مستحيل .. ارفق لك ملف قمت بعمل كود الترحيل قبل فترة في احد الجروبات .. قد يكون هناك تشابه بينه وبين ملفك .. اتمنى ان يساعدك في ايجاد الحل ترحيل.rar

وفيك بارك الله استاذنا ياسر .. دائما التلميذ يفتخر بالثناء والتشجيع من استاذه

في بداية الكود ActiveSheet.Unprotect "123" في نهاية الكود ActiveSheet.Protect "123" بافتراض ان 123 هي كلمة السر