hanan_ms

توسيــــــــــــع واستكمال 1- اضافة 78 هندسة لتوزيع الصور مع التمسية وترقيم فقط عليك كتابة الكود 2- اضافة ادراج النص مباشر الى نموذج المستهدف مع امكانية تكرار النص مع التسمية وترقيم ثم فقط عليك كتابة الكود 3- تحسين اللعبة التجريبة اسرعة وتحكم سريع اذا تبي تدرج صور تكون الجود واضح وحجم الصور مناسب للصور وليس النموذج وفكر عند تصميم رسم البياني يمكنك التجربة والاستمتاع (@)-=-(@)=(@)-=-(@)=(@)-=-(@)=(@)-=-(@)=(@)-=-(@)=(@)-=-(@)=(@)-=-(@)=(@)-=-(@)=(@)-=-(@)=(@)-=-(@)-/Card تحميل المرفق اسفل الفيديو تحميل المرفق https://www.mediafire.com/file/4a2vq6eu305p41p/Control_Disain_Ms_V_2.rar/file

نضيف قنوات يحتاج لك قائمة قنوات من مجموعات الى قنوات مع البحث والمفضلة وتحديث الروابط بجدول بسيط تسلم الانامل استاذ @Foksh ينقصها فك سرفرات

توسيــــــــــــــــــــــــــع واستكمال 1- استكمال ادوات التحكم بحجم المؤشر وطول النص والمساف لكل نص 2- زيادة المؤشرات من 10 الى 120 نص ومؤشر يلتف مره واحد كمجموعات اذا انتها يعيد 3- يمكنك الزايد الى 219 مع بعض التصحيحات يمكنك ضم في مشروعك هنا توضيح اشلون تزيد 😇 -=-=-=-=-=-=-=-=-=-=-=-=-=--=-=--=-=-=[ New ] المرفق اسفل الفيديو : تحميل المرفق https://www.mediafire.com/file/x49j7p0bdtmks60/T_V_OpenSures_V_2-3.rar/file

لتسهيل قبل التوسيــــــــــــع اداة بسيطة للتحكم وادراج الصورة في النموذج والتسمية وعدتة خيارات مع امكانية تحديد حذف العناصر واعادة او التعديل مع بعض توزيعات الهندسية ومن غير تسمية وايضا خلف بعض فقط عدل الكود والمزيد وصممة شبة لعبة بدقايق ما راي استاذ @Foksh مع اضافة اداة استاذ @Moosak للنجمة وتحديد العناصر مع التعليمات [V.1]:"============================================="(^) تحميل المرفق بعد الفيديون + شرح استاذ @Moosak تحميل المرفق https://www.mediafire.com/file/dhqsr8ud8cdn96i/Control_Disain_Ms_V_1.rar/file

توسيــــــــــــــــــــــــــع واستكمال 1- اضافة نسبة المئوية لقيمة المبلغ الاخمالي 2- اضافة العملات الى المبلغ مباشر 3- اضافة واستكمال الادوات الاعدادة لتحكم بشريط النصوص المتحرك من زيادة حجم النص وارتفاع الى سطرين لكل نص او 300 لسطر واحد مع خيار تنسيق الخط 😇 4- اضافة واجهة جديده كنت بحاول اطبق تعليمات استاذ @Moosak للتنسيق الاوان😂 وليلة ما عدة على الســـــــــــريع واتسكمال بتحديث ===( -=-=-=-=-=-=-=-=-=-=-=-=-=--=-=--=-=-=[ New ] المرفق اسفل الفيديو : تحميل المرفق https://www.mediafire.com/file/n598ilyi8n40hm2/T_V_OpenSures_V_2-2.rar/file

ممكن اقتراح استاذ @Foksh اضف دالة عشوائية للقرعة ليس الرندوم الغبي مصدر الوقت الحالي في اليوم الحالي والشهر والسنة كأنك تسوي رصد فلكي وقلب الفرز تصاعدي او تنازلي بكافة السجلات الفعلية يفيد للقرعة المزادات والسكني والترشيح الوظيفي - اقتراح مكعب الافعى 😂 لعبة اخر سكة الى اول نقطة او رقم بعدد المربعات تكون بالحظ وليس بالاختيار تصميمك بسيط وجميل لو مو مضغوطه بعمل آخر لرفعة عند تحريك مؤشر الماوس لتحريك المجسم داخل النموذج

توسيــــــــــــــــــــــــــع واستكمال تصحيح بعض الكوارث 😂 1- اصلاح مشكلة الفتح والاغلاق بسبب تضارب دالة UISetRoundRect بدالة QuickDoubleBuffering !!!بما تسبب في استغراق وقت اطول للفتح والاغلاق '=============( حدث عند اغلاق Dim run As Integer Call QuickDoubleBuffering("back_3", "back_1", "go", False) Call QuickDoubleBuffering("back_3", "back_1", "go_2", False) Call QuickDoubleBuffering("back_3", "back_1", "go_3", False) Call QuickDoubleBuffering("back_3", "back_2", "logen_T_V", False) 'Call QuickDoubleBuffering("back_3", "back_1", "go_3", "back_2", , , False) 'Call QuickDoubleBuffering("frmMain", "sub1", "sub2", , , , True) For run = 1 To 1 Form_go.TimerInterval = 0 Form_go_2.TimerInterval = 0 Form_go_3.TimerInterval = 0 'Form_logen_T_V.TimerInterval = 0 Next DoCmd.Close acForm, Me.Form.Name End Sub =================================( حدث تايمر عند الفتح Private Sub JKX_Click() Form_go.TimerInterval = 0 Form_go_2.TimerInterval = 0 Form_go_3.TimerInterval = 0 Form_logen_T_V.TimerInterval = 0 Dim jf As Integer For j = 1 To 200 '200 'round corners 'UISetRoundRect code in modCreateRoundCorners UISetRoundRect Form_logen_T_V, j, False DoEvents Next If Not IsNull(DLookup("[Speed_Move_Time]", "[Control_Move_text]")) Then For f = 1 To 1 Form_go.TimerInterval = DLookup("[Speed_Move_Time]", "[Control_Move_text]") Form_go_2.TimerInterval = DLookup("[Speed_Move_Time]", "[Control_Move_text]") Form_go_3.TimerInterval = DLookup("[Speed_Move_Time]", "[Control_Move_text]") Call QuickDoubleBuffering("back_3", "back_1", "go", True) Call QuickDoubleBuffering("back_3", "back_1", "go_2", True) Call QuickDoubleBuffering("back_3", "back_1", "go_3", True) ' Call UpdateTextColorsFromOtherForm DoEvents Next Call QuickDoubleBuffering("back_3", "back_2", "logen_T_V", True) Form_logen_T_V.TimerInterval = 50 Else For f = 1 To 1 Form_go.TimerInterval = 50 Form_go_2.TimerInterval = 50 Form_go_3.TimerInterval = 50 Call QuickDoubleBuffering("back_3", "back_1", "go", True) Call QuickDoubleBuffering("back_3", "back_1", "go_2", True) Call QuickDoubleBuffering("back_3", "back_1", "go_3", True) ' Call UpdateTextColorsFromOtherForm DoEvents Next Call QuickDoubleBuffering("back_3", "back_2", "logen_T_V", True) Form_logen_T_V.TimerInterval = 50 End If End Sub Public Sub UpdateTextColorsFromOtherForm() ' ' On Error Resume Next Dim ih As Integer Form_go.jk = 1 Form_go_2.jk = 1 Form_go_3.jk = 1 End Sub Private Sub Xcloc_Click() Call UpdateTextColorsFromOtherForm End Sub 2- تفعيل الاوان نصوص المتحركه في عداد الوقت عند التغير القيمة او ادوات التحكم عن طريق تمرير قيمة حقل ابسط ' دالة للتحقق من الحقل JX وتحديث الألوان Private Sub CheckJXAndUpdateColors() If Me.jk = 1 Then ' Call RefreshVisibleColors ReloadInProgress = True ' منع التنفيذ المتعدد ' إخفاء فوري للعناصر For i = 1 To 10 Me("A" & i).Visible = False Me("M" & i).Visible = False Next i ' إعادة التحميل الفوري Call LoadDataFromTable("MS_HAnan", "Text_N") Me.h200 = 1 Me.h400 = 500 intCount = 0 ReloadInProgress = False ' السماح بالتنفيذ مرة أخرى Me.jk = "" ' إعادة تعيين بعد الاستخدام End If End Sub Private Sub Form_Timer() On Error Resume Next Call CheckJXAndUpdateColors If ReloadInProgress Then Exit Sub ' منع التنفيذ أثناء إعادة التحميل 3- اضافة تحجيم الفيديو ليتناسب مع تسجيل الشاشة بخيارين كما موضح في الفيديو بسيط وتصحيح في YouTube مع بعض التغيرات وتحسينات يوجد لديكم مصميمين محترفين وهذه محاولة ستلاحظ سرعة الفتح والاغلاق ههه 😇 ملاحظة خارج الموضوع : اذا كان الجدول انشأ في اصدار اكسس سابق مثال 2016 لن تعمل نقل البيانات ولا تصدير ولا تغير نوع الحقل في الجدول او جدول في النموذج من غاطس او مظلل او .. ان كان العمل 2019 على اصدار اعلى منه 2019 ويفرق قيليل العمل Pro من يعمل على اصدار 24 (2) تحميل المرفق اسفل الفيديو ======================( ينقصة تحويل المبالغ الاجمالية الى نسبة وعرضها في الشريط مع تحكم النسبة مليارات ان كان قيمة عظما - اضافة اداة للتصميم فقط اختر الصور كمجموعات وارفاقها داخل النموذج بوضع التصميم مع التسمية اعتقد كان هناك عمل مشابة للاستاذ @Moosak 😇-- ضبط الجوده تحميل المرفق https://www.mediafire.com/file/h8exe7mjt807q4h/T_V_OpenSures_V_2-1_Fixo.rar/file

توسيــــــــــــــــــــــــــع واستكمال 1- استكمال عمل استاذ @Moosak 🌹 عند النقر للتقلص وتوسع يكون بنفس النوت المحدد النقر 😇 ملاحظة خارج الموضوع لتتبع اجراءات قيد مالي لا تسجل الى بعد شهر للربع الاول وللربع الثاني وللربع الثالث وللربع الرابع اقصد التتبع يكون بعد شهر وليس كاشير بنفس اليوم تحاسب عندك 3 شهور للربع لا يضعونك بطلب ما^ يشتغل بعد مرور فترة ترك واهمال ثابت يرجع على الموظف كرقابة المالية تقريبا التسجيل بعد شهر لكل نهاية شهر 😇 2- اضافة تحكم بشريط المؤشر اللون والسرعة والمسافة والرموز 3- تستطيع عمل نفس لون الزر حسب تصنيف نسبة المؤشر كانت 1 او 2 او 3 يمكن الزيادة 4- زيادة في العرض انتقل من 5 الى 10 كدفعت مجموعات اشلون تخلي المبالغ نسبة مئوية ====================( تحديث ان امكن تحكم اكثر حتى بعرض المحدد لكل مجموعة لكل دوران مع تحميل المرفق اسفل الفيديو المرفق https://www.mediafire.com/file/89aa3rpuc9gndwk/T_V_OpenSures_V_2.rar/file

توسيــــــــــــــــــــــــــع واستكمال * تغير الشريط الى دارك مود مع بعض التحسين * 1- عرض ثلاث اشرطة تحت بعض للشركات والموظفين بنص متحركة حسب نسبة المؤشر 2- قائمة التحكم بالاضافة وتعديل والمفترض استعلام 😇 مرفق التحميل اسفل الفيديو ========================================================================*^* تحميل المرفق https://www.mediafire.com/file/ot26afk6vbof41c/T_V_OpenSures_V_1.rar/file

فيديو 3 ومرفيقين 2 + هديه مرفق Cinema 4D بسيط جدا من جدول لو كان من استعلام يعرض كافة الشركات المتعاقدة او طبخات دولية 😂 او ابداعات فنية 😂 وجعلة تنظيم قنواتك في اليوتيوب وكتابة وتدوين الملاحظات وتستطيع اضافة المشاركين واضافتهم في شريط المتحرك مع فيديو لقناتك مع اضافة شعار لقناتك او الشركة من خلال تصميم الشعار من برنامج Cinema 4d محاولة 1- يتضمن مرفق Cinema 4d مع شرح طريقة الاستخدام البسيطة فقط غير الصورة ثم ارفاقة في النموذج 2- يمكن تعديل مصدر الجدول باضافة دالة IFF -لتحديد اعلى وادنى قيمة ارقام لعرض السهم في النص المتحرك 3- الملاحظات من غير استخدام انشاء استعلامات وانما استعلام داخل الكود تحديد كل السنوات وتحديد الشهر وعرض الاجماليات وعرض الكل مع تقليص لعرض التاريخ مع الملاحظات والتوسيع توضيح اسفل الفيديو في الاسفل 4D بتعديل مرفق استاذ @Moosak 🌹 😇 ==================( تعديل الدالة False , Ture في التحديث 😇 مرفق شريط نص المتحرك لكافة سجلات في الجدول https://www.mediafire.com/file/ooh644tejv8k997/T_V_OpenSures.rar/file مرفق معد من استاذ @Moosak للملاحظات https://www.mediafire.com/file/bh1ffw53nau9zzf/__Notes+-+v2+(1).rar/file

جرب عرض التقرير @عبد الله قدور وتجنب استخدام طرف ثالث او رابع 1- طول الصفحة راسية والعرض صفحة افقية + وبعد غلاف وصور 😇 2- تشغيل قائمة اسرع وتستطيع التجربة مصدر جدول مستمر راس النموذج ازرار وتذيليل النموذج ازارا نفس الفكرة مع دالة معدلة لمصدر استعلام وجداول قريبا لتصميم للقوائم الجانبية المرفق اسفل الفيديو اذا حاب تفرع من جدول علاقات اضافة لجدول المفرع احتساب ID & "." & IDD مع دالة بسيط للقوائم الجانبية وكود لتشغيل الصفحة كامل التقرير 0 هوامش + استخراج PDF عالي الجودة عن طريق استخدام طباعة مايكروسوفت بي دي اف Private Sub Report_Load() On Error Resume Next With Reports(Me.Report.name) '==========================( اذا كان بطول نوع الصفحة رأسية) ' تعيين الأبعاد المطلوبة ' .Width = 8.5 * 1440 ' تحويل البوصة إلى twips ' .Height = 11.1 * 1440 '==========================( اذا كان بالعرض نوع الصفحة افقية) ' تعيين الأبعاد المطلوبة .Width = 11.7 * 1440 ' تحويل البوصة إلى twips .Height = 7.1 * 1440 ' تحديد الهوامش بالمليمتر (1/567 سنتيمتر تقريبًا لكل وحدة) .TopMargin = 0 .BottomMargin = 0 .LeftMargin = 0 .RightMargin = 0 End With كود تصدير التقرير PDF HD 0 هوامش Private Sub S_X_Click() '------------------( Msgbox )-Only Dim strMsg_Give_Nmae As response Dim MsG1 As String Dim MsG2 As String Dim MsG3 As String '--------------------------------- Dim Rep As String Dim FilePath As String Dim password As String Dim response As VbMsgBoxResult Dim prtDefault As printer Dim prtTemp As printer Dim reportName As String Dim ReportName_X As String Dim Object_J_1 As Long Dim Object_J_2 As Long Dim Object_J_3 As Long Dim Object_J_4 As Long Dim Object_J_5 As Long Dim Run_Object_J As Integer On Error GoTo ops ' تأكد أن الطابعة Microsoft Print To PDF مثبتة ومفعلة في النظام '==================================( No use Tablte Control IF Tablt = Dlookup , User = Name ***** ) '========( 1 - Only Save Report Set Path - 2-Only Save Report Set Path selectd user (Object_J_1)1,2 '========( 1- No Password PDF - 2- Yes Password PDF - 3- Yes Password PDF Selected User (Object_J_2)1,2 '========( 1- show Form - 2-Show Open File - 3-No Show (Object_J_3)1,3 '========( 1- Aout Name File - 2-Name File withAout - 3-User Name (Object_J_4)1,3 '========( 1- Show Report Form - 2- Open File PDF -(Object_J_5)1,2 **********( For Close = 0) Only MasBox_JK Object_J_1 = 1 Object_J_2 = 1 Object_J_3 = 1 Object_J_4 = 1 Object_J_5 = 1 '*******************( Set (1)) 'حفظ الطابعة الحالية Set prtDefault = Application.printer Rep = Me.Name_report.caption reportName = Rep ' إضافة هذا السطر لتعريف ReportName '***********************( Run Cod (J)) For Run_Object_J = 1 To 3 '===================================================================================( 1 If Run_Object_J = 1 Then If Object_J_1 = 1 Then '=====( Set path Copy to filePath ) If Object_J_4 = 1 Then ReportName_X = format(Date, "dd-mm-yyyy") & "-" & format(Now(), "Hh-Nn-ss-AM.") End If FilePath = "C:\Users\Ezril\Documents\" & ReportName_X & ".pdf" End If If Object_J_1 = 2 Then 'فتح مربع حوار لحفظ الملف With Application.FileDialog(msoFileDialogSaveAs) .title = "اختر مسار حفظ التقرير PDF" .initialFileName = CurrentProject.path & "\" & ReportName_X & ".pdf" If .Show = -1 Then FilePath = .SelectedItems(1) Else GoTo exit_Ops ' تغيير من Exit Sub إلى GoTo exit_Ops End If End With End If End If '================================================================================( 2 If Run_Object_J = 2 Then '==============(1 Or If Object_J_2 = 1 Then 'تحديد الطابعة "Microsoft Print to PDF" For Each prtTemp In Application.Printers If prtTemp.DeviceName = "Microsoft Print to PDF" Then Set Application.printer = prtTemp Exit For End If Next prtTemp Set Application.printer = Application.Printers("Microsoft Print to PDF") 'طباعة التقرير إلى الطابعة المحددة DoCmd.openReport reportName, acViewPreview DoCmd.OutputTo acOutputReport, reportName, acFormatPDF, FilePath, False ' ستظهر لك نافذة حفظ PDF - بعض الأنظمة تسمح تحديد الملف تلقائياً عبر registry ' أسهل حل أن تكتب اسم الملف في مربع الحوار عند الطباعة أو تستخدم أداة مثل PDFCreator 'إرجاع الطابعة الأصلية Set Application.printer = prtDefault ' Set Application.printer = Application.Printers(oldPrinter) End If '==============(2 Or If Object_J_2 = 2 Then '=================( Set psword Or Form DlookUp tablet password = "123" 'تحديد الطابعة "Microsoft Print to PDF" For Each prtTemp In Application.Printers If prtTemp.DeviceName = "Microsoft Print to PDF" Then Set Application.printer = prtTemp Exit For End If Next prtTemp 'طباعة التقرير إلى الطابعة المحددة DoCmd.openReport reportName, acViewNormal, , , acHidden ' إرجاع الطابعة الأصلية Set Application.printer = prtDefault End If '===============(3 Or If Object_J_2 = 3 Then 'سؤال عن كلمة المرور response = MsgBox("هل تريد إضافة كلمة مرور للـ PDF بعد الطباعة ؟", vbYesNo + vbQuestion, "تأكيد") If response = vbYes Then password = InputBox("أدخل كلمة المرور للـ PDF:", "كلمة المرور") End If 'تحديد الطابعة "Microsoft Print to PDF" For Each prtTemp In Application.Printers If prtTemp.DeviceName = "Microsoft Print to PDF" Then Set Application.printer = prtTemp Exit For End If Next prtTemp 'طباعة التقرير إلى الطابعة المحددة DoCmd.openReport reportName, acViewNormal, , , acHidden ' إرجاع الطابعة الأصلية Set Application.printer = prtDefault End If End If '================================================================================( 3 If Run_Object_J = 3 Then '==============(1 Or If Object_J_3 = 1 Then DoCmd.openForm "RepotX" Forms!RepotX.ww.ControlSource = "=""" & FilePath & """" End If '==============(2 Or - تم تصحيح الرقم من 1 إلى 2 If Object_J_3 = 2 Then On Error Resume Next Application.FollowHyperlink FilePath End If End If Next Run_Object_J ' إغلاق الحلقة For الرئيسية '**************************** (Run Finsh Code ) ******************************** 'إذا كان هناك كلمة مرور، نستخدم 7-Zip أو أداة PDFEncrypt If password <> "" Then Dim protectedPath As String protectedPath = Left(FilePath, Len(FilePath) - 4) & "_protected.pdf" ' مثال باستخدام أداة خارجية PDFEncrypt.exe (ضع مسارها الصحيح) ' Shell """C:\Tools\PDFEncrypt.exe"" -in """ & filePath & """ -out """ & protectedPath & """ -password """ & passWord & """", vbHide 'أو باستخدام 7-Zip لضغط الملف بكلمة مرور (سيكون بصيغة zip) Shell "7z a -tzip -p" & password & " """ & protectedPath & """ """ & FilePath & """", vbHide '-------------------------( Code Msgbox ) MsG2 = "Sand Massage !" MsG1 = "تم التنفيذ بنجاح" MsG3 = "تم حفظ نسخة محمية بكلمة مرور في: " & vbCrLf & protectedPath MyMsgBox (MsG3), (MsG2), (MsG1), msg_Information, Btn_OK_Only, Arabic_Center ', True, 2.5 '----------------------------------------- Else '-------------------------( Code Msgbox ) MsG2 = "Sand Massage !" MsG1 = "تم التنفيذ بنجاح" MsG3 = "تم حفظ PDF بنجاح في: " & vbCrLf & FilePath MyMsgBox (MsG3), (MsG2), (MsG1), msg_Information, Btn_OK_Only, Arabic_Center ', True, 2.5 '----------------------------------------- End If '===================( Chack Data ) If DCount("*", "[File_Dial_SyS]") = 0 Then '-------------------------( Code Msgbox ) MsG2 = "Sand Massage !" MsG1 = "الغاء التنفيذ" MsG3 = " لا يوجد ملف تم اضافتة من الاصل السجلات 0 البيانات , اضافة ملف جديد وتأكد من البيانات الصحيحة ثم اعادة المحاولة " MyMsgBox (MsG3), (MsG2), (MsG1), msg_Erorr_Job, Btn_OK_Only, Arabic_Center ', True, 2.5 '----------------------------------------- Exit Sub End If If DCount("*", "[Name_Job_Cutomar_File]") = 0 Then '-------------------------( Code Msgbox ) MsG2 = "Sand Massage !" MsG1 = "الغاء التنفيذ" MsG3 = " لا يوجد اسماء موظفين مختصين تم ادراجهم؟! ثم اعادة المحاولة " MyMsgBox (MsG3), (MsG2), (MsG1), msg_Erorr_Job, Btn_OK_Only, Arabic_Center ', True, 2.5 '----------------------------------------- Exit Sub End If If DCount("[k]", "[Name_job_Customar_k]") = 0 Then '-------------------------( Code Msgbox ) MsG2 = "Sand Massage !" MsG1 = "تم الغاء التنفيذ" MsG3 = " لم تحدد موظف مختص او موظفين لطباعة التقرير " MyMsgBox (MsG3), (MsG2), (MsG1), msg_Exclamation, Btn_OK_Only, Arabic_Center ', True, 2.5 '----------------------------------------- Exit Sub End If '-----------------------------------------------------------------------( For Error Code Only Copy And No Can use Function = Here Error :) X exit_Ops: Exit Sub ops: Dim Error_Finction As String Error_Finction = err.number & ":" & err.Description _ & ":" & Me.ActiveControl.name & ":" & Me.Form.name Error_Now (Error_Finction) DoEvents Resume exit_Ops End Sub تحميل المرفق : https://www.mediafire.com/file/fha9c7tc2ubydte/REport_Desian_Menu_V1.rar/file

لعمل تأمين البيانات بعيد من اي عابث حتى من الاعدادة الخطأ التي تحجر الملفات او الحذف من بعض بربامج الحماية ومن يستغل هذا للانجاز الوهمي كمسئول امن المعلومات ولكن سوف يتسبب بتضارب الملفات القديم بالجديدة اذا استرجع الحجر والحذف مصيبة ومتكرر ايضا باختصار فقدان البينات لو بسهو او انه لا يعلم عن الاعدادة او تعمد ذلك يصل العقوبة امن المعلومات كمسئول 6 سنوات وافشاء اسرار والمستندات لاي موظف واثبت العمد بنشر او توزيع يصل 4 سنوات الموضوع هو تأمين البيانات بصورة مباشرة كان لشركة او وزارة كل مفعل خدمات منها OneDrive يجب الا يكون متزامن حتى لا يتعرض للمسح من قبل برامج الحماية واسوأهم كاسبر اسكي لا يحترم العملاء يغلق النظام اجباري ويعتقد الكثير ان يوجد خلل في الحماية ! المتطلبات يجب ان يكون الرفع تلقائي مباشر عند الوقت وحتى التنزيل مباشر عند ضغط مع توزيع في المكان المطلوب حتى الموظف لا يتعرض لظلم والاهمال في عمل وتكرار العمل امر مرهق وضياع الجهد 1-فطلب دالة تقوم برفع الملف او المجلد الى OneDrive , 2-والعكس تقوم باسترجاع وتنزيل الملف النسخ كل ساعة مع امكانية ايقافة والجميل يجب الا يكون عند بداية التشغيل بسبب تفعيل المسح من حماية عند بداية التشغيل او يأتي يوم يخرج ما في الحجر كحجر الصحي ويضرب في التراسل والاوراكل 🙂 وهذه الطريق ممتازه للحل بعد وحدات التخزين مكان افلاش مغلق دعوى لاستاتذه للحلول المناسبة @Foksh و @Moosak و @ابو جودي ومن لديه ما يساعد 🌹☕ لتوضيح الطلب 😇

تحديــــــــــــث بسيط 1- تعديل بسيط بالاعدادة لعرض جذر وتبعه للبحث والتصفية 😇 2- تصميم بسيط لواجهة الاعداداة ============================( المرفق اسفل الفيديو تحميل المرفق https://www.mediafire.com/file/y763f00bdk66zgk/V2_API_WS_EX_COMPOSITED.rar/file

تحديــــــــــــث بسيط 1- تسريع التنقل عند القائمة الجانبية عند كود استاذ @Moosak 😇 تم الغاء الكود ' Me.Repaint 2- تفعيل الوقت مع القائمة جانبية مع بعض التصحيحات وتكبير ============================( المرفق اسفل الفيديو تحميل المرفق https://www.mediafire.com/file/ruzomjy5j9pdhv2/V1_API_WS_EX_COMPOSITED.rar/file

نمط تفاعلي للواجهة ويوجد انماط اخرى 😇 تعديل على مرفق @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