كل الانشطه

انا استخدم هذه انواع .. باركود.rar

( عند بيع مواد لازم ينقص عدد من مخزن من جدول tabl1 من حقل save ) كود داخل مربع نص txtsave يوجد في اخطاء ... كود تحديث جدول Updaterecodre.accdb

تمام

السلام عليكم كنت محتاج من حضراتكم ترشيح خطوط الباركود التي تعمل على الاكسيس بدون مشاكل سواء في قرائتها من خلال سكانر الباركود او في طباعتها اين ممكن ان نجدها او نحملها و جزاكم الله خيرا

مشاركةً مع استاذ @Foksh تفضل استاذ @BRAHIM Ben aissa مرفقي ووافنا بالرد . close option and shift.rar

تمام استاذ عبد الله الف شكر تحياتي لك ا

وعليكم السلام ورحمة الله وبركاته .. أخي الكريم بدايةً اهلاً وسهلاً بك في المنتدى عضواً جديداً ، ونتمنى ان تجد ما تبحث عنه بسهولة . بدايةً استعمل خاصية البحث لإيجاد المواضيع التي تتحدث عن مشكلتك بل طرحها ، علك تجد ضالتك بسرعة وسهولة .. أما بخصوص طلبك ، فإليك هذه الدالة البسيطة :- Private Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) Dim dbs, prp As Property Const conPropNotFoundError = 3270 Set dbs = CurrentDb On Error GoTo Change_err dbs.Properties(strPropName) = varPropValue ChangeProperty = True Change_Bye: Exit Function Change_err: If Err = conPropNotFoundError Then Set prp = dbs.CreateProperty(strPropName, varPropType, varPropValue) dbs.Properties.Append prp Resume Next Else ChangeProperty = False Resume Change_Bye End If End Function ويتم استدعائها في أي حدث تريده كحدث عند فتح أول نموذج لك في مشروعك بالشكل التالي لقفل مفتاح الشيفت :- ChangeProperty "AllowBypassKey", DB_BOOLEAN, False أو في زر لإعادة تفعيل مفتاح الشيفت بالإستدعاء التالي :- ChangeProperty "AllowBypassKey", DB_BOOLEAN, True

وعليكم السلام ورحمة الله وبركانه اليك التصحيج Sub Filter_Class2() Dim WSdest As Worksheet: Set WSdest = Sheets("TI3DAD") Dim D1 As Object, D2 As Object, D3 As Object, D4 As Object Dim I As Long, x As Long, Y As Long, m As Long, z As Long Dim Réf As Variant, ky As Variant, Rng As String Set D1 = CreateObject("Scripting.Dictionary") Set D2 = CreateObject("Scripting.Dictionary") Set D3 = CreateObject("Scripting.Dictionary") Set D4 = CreateObject("Scripting.Dictionary") x = 0: Y = 0: m = 0: z = 0 With WSdest Application.ScreenUpdating = False .Range("M4:V32,X4:AG32,AI4:AR32,AT4:BC32").ClearContents I = 7 Do While I <= .Rows.Count If .Cells(I, 2) <> "" Then Rng = Left(Trim(.Cells(I, 2).Value), 1) Réf = Application.Transpose(.Cells(I, 2).Resize(, 13).Value) Réf = Application.Transpose(Réf) Select Case Rng Case "4" D4(z) = Join(Réf, "*") z = z + 1 Case "3" D3(Y) = Join(Réf, "*") Y = Y + 1 Case "2" D2(x) = Join(Réf, "*") x = x + 1 Case "1" D1(m) = Join(Réf, "*") m = m + 1 End Select I = I + 1 Else Exit Do End If Loop m = 4 If D4.Count > 0 Then For Each ky In D4.Keys .Cells(m, "M").Resize(, 13).Value = Split(D4(ky), "*") m = m + 1 Next ky End If m = 4 If D3.Count > 0 Then For Each ky In D3.Keys .Cells(m, "X").Resize(, 13).Value = Split(D3(ky), "*") m = m + 1 Next ky End If m = 4 If D2.Count > 0 Then For Each ky In D2.Keys .Cells(m, "AI").Resize(, 13).Value = Split(D2(ky), "*") m = m + 1 Next ky End If m = 4 If D1.Count > 0 Then For Each ky In D1.Keys .Cells(m, "AT").Resize(, 13).Value = Split(D1(ky), "*") m = m + 1 Next ky End If .Range("M4").CurrentRegion.Value = .Range("M4").CurrentRegion.Value .Range("X4").CurrentRegion.Value = .Range("X4").CurrentRegion.Value .Range("AI4").CurrentRegion.Value = .Range("AI4").CurrentRegion.Value .Range("AT4").CurrentRegion.Value = .Range("AT4").CurrentRegion.Value Application.ScreenUpdating = True End With End Sub 1تعداد.xlsm

نمط تفاعلي للواجهة ويوجد انماط اخرى 😇 تعديل على مرفق @Moosak 1- طريقة الاستخدام الواجهة اذا كنت ترغب بتعديل بقائمة الجنب يعمل مستمر مع دالة عند ضغط لاي زر في واجهة الاخرى الرئيسية او حدث ايقاف التفعيل ثم التفعيل فقط الدالة والمرفق والشرح بموضوع @Moosak اسفل الفيديو ================================================( بسيط يمكن اضافة قائمة لاختيار انماط الحقول بدل من المسار الدالة : Option Compare Database Option Explicit #If VBA7 Then Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" _ (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" _ (ByVal hwnd As LongPtr, ByVal nIndex As Long, _ ByVal dwNewLong As LongPtr) As LongPtr #Else Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _ (ByVal hwnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hwnd As Long, ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long #End If Private Const GWL_EXSTYLE = (-20) Private Const WS_EX_COMPOSITED = &H2000000 '==== دالة عامة تحدد النموذج بالاسم وتفعّل/تُلغى الـ DoubleBuffering ==== Public Sub ToggleFormDoubleBuffering(FormName As String, EnableIt As Boolean) Dim hWndForm As LongPtr ' تأكد أن النموذج مفتوح If Not CurrentProject.AllForms(FormName).IsLoaded Then MsgBox "النموذج " & FormName & " غير مفتوح.", vbExclamation Exit Sub End If ' اجلب الـ hWnd hWndForm = Forms(FormName).hwnd #If VBA7 Then Dim style As LongPtr style = GetWindowLongPtr(hWndForm, GWL_EXSTYLE) If EnableIt Then style = style Or WS_EX_COMPOSITED Else style = (style And Not WS_EX_COMPOSITED) End If SetWindowLongPtr hWndForm, GWL_EXSTYLE, style #Else Dim style32 As Long style32 = GetWindowLong(hWndForm, GWL_EXSTYLE) If EnableIt Then style32 = style32 Or WS_EX_COMPOSITED Else style32 = (style32 And Not WS_EX_COMPOSITED) End If SetWindowLong hWndForm, GWL_EXSTYLE, style32 #End If End Sub 'تفعيل DoubleBuffering على نموذج معين 'Call ToggleFormDoubleBuffering("اسم_النموذج", True) 'إلغاء DoubleBuffering على نموذج معين 'Call ToggleFormDoubleBuffering("اسم_النموذج", False) Public Sub ToggleFormOrSubformDoubleBuffering(FormName As String, Optional SubformControlName As String = "", Optional EnableIt As Boolean = True) Dim hWndForm As LongPtr If Not CurrentProject.AllForms(FormName).IsLoaded Then MsgBox "النموذج " & FormName & " غير مفتوح.", vbExclamation Exit Sub End If If SubformControlName <> "" Then hWndForm = Forms(FormName).Controls(SubformControlName).Form.hwnd Else hWndForm = Forms(FormName).hwnd End If ' تطبيق النمط #If VBA7 Then Dim style As LongPtr style = GetWindowLongPtr(hWndForm, GWL_EXSTYLE) If EnableIt Then style = style Or WS_EX_COMPOSITED Else style = (style And Not WS_EX_COMPOSITED) End If SetWindowLongPtr hWndForm, GWL_EXSTYLE, style #Else Dim style32 As Long style32 = GetWindowLong(hWndForm, GWL_EXSTYLE) If EnableIt Then style32 = style32 Or WS_EX_COMPOSITED Else style32 = (style32 And Not WS_EX_COMPOSITED) End If SetWindowLong hWndForm, GWL_EXSTYLE, style32 #End If End Sub 'على نموذج رئيسى 'Call ToggleFormOrSubformDoubleBuffering("frmMain", , True) 'على نموذج فرعى داخل نموذج رئيسى 'Call ToggleFormOrSubformDoubleBuffering("frmMain", "subMyForm", True) تحميل المرفق https://www.mediafire.com/file/1qo54r19srcfear/API_WS_EX_COMPOSITED.rar/file

السلام عليكم إخوتي و أساتذتي الكرام في الملف المرفق أريد ترحيل تعداد التلاميذ حسب الجدول كلاً إلى مستواه مثلا : 4م1 - 4م2 -........الى جدول السنة الرابعة 3م1 - 3م2 -.........الى جدول السنة الثالثة 2م1 - 2م2 -.........الى جدول السنة الثانية 1م1 - 1م2 -.........الى جدول السنة الأولى كود الترحيل مع الملف هو لأحد أساتذة المنتدى جزاه الله خيرا كنت قد استعملته مع ثلاث مستويات و بعد الاضافة لم أتمكن من معرفة الخلل. تعداد.xlsm

تم نقل اختيار الإجابة لإجابة الأستاذ @عبدالله بشير عبدالله ، وليست لتعليقي أخي الكريم .. ونعلم إنها سهواً ، وتم تصحيح اختيار الإجابة

شكراً لمجهودك وعطائك المستمر

تم التفعيل أستاذنا الكريم شكراً لتفاعلك

تفضل يا غالى

بارك الله فيك استاذ ابو احمد نفع الله بك وبعلمك سيتم التجربه

العفو اخي الكريم 😇

سبحان الله، الموضوع كان نشط وبمجرد شاركت أنا فيه نام وخمد!! نفس الفكرة ولكن من خلال زر ارقام النتائج عربي_05.xlsm

جزاك الله خير وبارك فيك استاذي الفاضل ابا خليل ملاحظاتك كلها بعين الاعتبار والتقدير والف شكر لك🌹 والف شكر لك استاذي الفاضل @Foksh تم تطبيق الكود كما طلبت جزاك الله خير وبارك فيك

توسيـــــــــــع اكثر ************************************ ( استكــــــــــــــــمال 😇 1- اضافة تغير نمط الازرار عند التحريك والضغط سهل 2- اضافة قائمة منسدلة مع تغير النمط واذا ترغب باسهل حدد مثال عشرين حقل مع التقسيم جدول يوجد امثلة سابقة بس لمثال @Moosak افضل مسار الصور خارج القاعدة في المثال الحالي تغير نمط الحقول من نفس النموذج احتمال استخدم الصور من داخل الجدول كمتغير لمثال @Moosak😇 3- اضافة انواع جديد من شريط التقدم تحميل المرفق اسفل الفيديو تحميل المرفق https://www.mediafire.com/file/vdd6bg8mucv9z5w/New_Clock_Skin_8D_Logine+To+8+And+SKin_Tab_with_GrubV1_Update_Silent-Print-with_Out_PDF.rar/file

إلغاء مفتاح الشفت وتفعيله

هذا بيت القصيد لن يشعر بما صنعته له .. ولن يختلف عليه شيء المعنى ان التوقيع الأول حضور والثاني انصراف .. بناء على : معيار تاريخ اليوم .. ويمكننا جعل وقت الدوام مفتوح خلال اليوم ولا نحصره بين ساعات محددة ومنعا للتكرار الغير مقصود ( ودوما يحصل ) نجعل شرط فاصل وقت _ دقيقة مثلا _ بين التوقيع الأول والتوقيع الثاني

و عليكم السلام بداية يمكن عمل ذلك عن طريق التحقق من الصحة و الأفضل ارفاق ملف للعمل عليه

السلام عليكم طبعا الفكره قديمه واحد الاخوه كان عامل مثلها ولاكن انا عدلت عليها بطريقه تكون سهلة وبسيطة وبدون اي شرح اليكم الببرنامج رسائل.zip

استاذ @dd13901390 تم اضافة حقل لمسار المستند بالجدول فهل هذا ما تقصد .اليك الشرح والمرفق . ووافني بالرد . dd13901390 - 2.rar

ههههههه سؤال قوي ، حبة الدوا ما بتعرف راسها من رجليها ..