نجوم المشاركات

الموضوع تعبنى جدا والله وكان تحدى صعب احب التنويه الى شئ استخدام sleep اثناء العمل قد يصيب الأكسس بالتجميدوالشلل وقد يعلق فى الذاكرة ولذلك ابتعدت عن ضبط الاكواد من خلالها واليكم نتيجة التحدى اولا تم مراعاة وضع الاكواد فى وحدة نمطية ليتم استخدامها فى اكثر من نموذج حتى لو اختلف وتعددت الوان أزرار الأوامر ومهما اختلفت اسماء او عناوين الأزرار وفى حاجة كمان لو عاوزيين نلون لون الزرار بالاصفر بس ومنغيرش تسمية عنصر التسمية ممكن جدا جدا ومن نفس الكود يعنى كود ذكى وابن حلال وبيقدر يفهمنا من أول تكه على الزرار اه والله زيمبئولكم كده.. شغل فاخر من الاخر اومااااااااااال 1- أكواد الوحدة النمطية Option Compare Database Option Explicit ' Constant that specifies the time interval for color flashing (in seconds) Const dblTimeInterval As Double = 0.5 ' Constant that determines the number of times the colors will flash Const intFlashCount As Integer = 5 ' Variable to track whether Label flashing should occur Public AllowFlashing ' Public variables to store default values Public btnControlDefaultColor As Long Public lblControlDefaultColor As Long Public strLblControlCaption As String Public formIsClosing As Boolean ' Public variable to store the selected button Public selectedButton As CommandButton ' Function to return the highlighted color Function ApplyHighlighted() As Long ApplyHighlighted = RGB(255, 255, 0) End Function ' Subroutine to set the button color Sub ButtonColor(ByVal frm As Form, Optional btn As CommandButton = Nothing, Optional DisableLabelChange As Boolean) ' Set the default button color if not highlighted If Not btn Is Nothing Then If btn.BackColor <> ApplyHighlighted Then btnControlDefaultColor = btn.BackColor ' Clear the previous button's highlight If Not selectedButton Is Nothing Then selectedButton.BackColor = btnControlDefaultColor End If ' Set the new button as selected and highlight it btn.BackColor = ApplyHighlighted ' Save the caption of the current button If Not DisableLabelChange Then strLblControlCaption = btn.Caption End If Set selectedButton = btn End If End Sub ' Subroutine to flash the label control Sub FlashLabelControl(frm As Form, lblControl As Object, DisableLabelChange As Boolean) On Error GoTo ErrorHandler Dim flashingColor As Long Dim flashingInterval As Single Dim flashCount As Integer Dim flashTimer As Single Dim i As Integer On Error GoTo 0 ' Turn off error trapping. On Error Resume Next ' Defer error trapping. ' Set the default label color if not highlighted If lblControl.BackColor <> ApplyHighlighted Then lblControlDefaultColor = lblControl.BackColor flashingColor = ApplyHighlighted flashingInterval = dblTimeInterval flashCount = intFlashCount ' Reset the label color to the default when the form is loaded If TypeOf lblControl Is Access.Label And Not formIsClosing Then lblControl.BackColor = lblControlDefaultColor If Not DisableLabelChange Then lblControl.Caption = strLblControlCaption End If End If flashTimer = Timer + flashingInterval ' Flash the label color For i = 1 To flashCount Do While Timer < flashTimer And Not formIsClosing DoEvents Loop ' Update the label color during the flash If TypeOf lblControl Is Access.Label And Not formIsClosing Then If AllowFlashing Then ' Check the AllowLabelCaptionChange value to determine whether to change the caption If Not DisableLabelChange Then lblControl.Caption = IIf(lblControl.Caption = strLblControlCaption, strLblControlCaption, vbNullString) End If lblControl.BackColor = IIf(lblControl.BackColor = lblControlDefaultColor, flashingColor, lblControlDefaultColor) End If End If ' Update the flash timer flashTimer = Timer + flashingInterval Next i ' Reset the label color to the default after flashing If TypeOf lblControl Is Access.Label And Not formIsClosing Then lblControl.BackColor = lblControlDefaultColor If Not DisableLabelChange Then lblControl.Caption = strLblControlCaption End If End If ' 2467 Err.Clear ' Clear Err Exit Sub ' Exit to avoid handler. ErrorHandler: ' Error-handling routine. Select Case Err.Number ' Evaluate error number. Case Is = 2467 flashCount = 0 flashTimer = 0 Exit Sub ' Exit to avoid handler. Case Else ' Handle other situations here... MsgBox Err.Number & ": " & Err.Description Resume ' Resume execution at the same line End Select End Sub ' Subroutine to change the button color and control Label flashing Sub ChangeCommandButtonColor(frm As Form, Optional lblControl As Object, Optional DisableLabelChange As Boolean) On Error GoTo ErrorHandler Dim clickedButton As CommandButton Set clickedButton = frm.ActiveControl On Error GoTo 0 ' Turn off error trapping. On Error Resume Next ' Defer error trapping. ' Clear the previous button's highlight If Not selectedButton Is Nothing Then selectedButton.BackColor = btnControlDefaultColor lblControl.Caption = "" strLblControlCaption = "" End If ' Set the new button as selected and highlight it Set selectedButton = clickedButton ' Update the label caption If Not DisableLabelChange Then strLblControlCaption = clickedButton.Caption End If ' Apply the button color and control Label flashing ButtonColor frm, clickedButton, True ' Check if lblControl is provided and is a valid object If Not lblControl Is Nothing Then AllowFlashing = Not DisableLabelChange ' Determine whether to trigger flashing lblControl.Caption = strLblControlCaption FlashLabelControl frm, lblControl, False End If Err.Clear ' Clear Err Exit Sub ' Exit to avoid handler. ErrorHandler: ' Error-handling routine. Select Case Err.Number ' Evaluate error number. Case Is = 5 Exit Sub ' Exit to avoid handler. Case Else ' Handle other situations here... MsgBox Err.Number & ": " & Err.Description Resume ' Resume execution at the same line End Select End Sub 2- الاكواد للاستخدام من خلال النموذج ولا اسهل من كده.. يا عينى ع الدلع Private Sub Form_Load() formIsClosing = False End Sub Private Sub Form_Close() formIsClosing = True End Sub Private Sub Command1_Click() ' Call the ChangeCommandButtonColor subroutine with the current form and label control (lblDisplayTitle). ChangeCommandButtonColor Me, Me.lblDisplayTitle End Sub Private Sub Command2_Click() ' Call the ChangeCommandButtonColor subroutine with the current form and label control (lblDisplayTitle). ChangeCommandButtonColor Me, Me.lblDisplayTitle End Sub Private Sub Command3_Click() ' Call the ChangeCommandButtonColor subroutine with the current form and label control (lblDisplayTitle). ChangeCommandButtonColor Me, Me.lblDisplayTitle End Sub Private Sub Command4_Click() ' Call the ChangeCommandButtonColor subroutine with the current form and label control (lblDisplayTitle). ChangeCommandButtonColor Me, Me.lblDisplayTitle End Sub Private Sub Command5_Click() ' Call the ChangeCommandButtonColor subroutine with the current form only without label control (lblDisplayTitle). ' To disable Allow Label Caption Change = True ChangeCommandButtonColor Me, Me.lblDisplayTitle, True End Sub معلش انا شرحت كل شئ ع الأكواد بالانجليزى طبعا مش فلسفة علشان عارف انت هتقول ايه سامعك... علشان العربى بيعمل مشاكل فى الاعدادت الاقليمية للغة لو مكانت مضبوطه بس خلاص • وأخيرا المرفق FlashLabel.accdb

سيبها زي ماهية..فقط احفضها بكلمة مرور لديك وليس لدى العميل ...والمفضل ان تحفظ القاعدة الخلفة في بارتشن زي الدي مثلا

مش عايزك تقلق طول ما اوفيسنا و @Foksh موجود احنا في امان 😄💪💪💪

لا مشكلة في إنك تحولها ، أو تتركها دون تحويل ، هي الفكرة فقط في حال التطوير والتعديل فإنك تفقد هذه الصلاحية اذا قمت بتحويلها 😊

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

لا أزايد على خبرة الأستاذ @jjafferr ، ولكن يبدو أن (.) سقطت سهواً في المديول mod_ConvertToaccDE استبدله بهذا الكود ، فقط . Option Compare Database Option Explicit Public Function ConvertToaccDE(sourcedb As String, targetdb As String) Dim accessApplication As Access.Application Dim extn As String extn = db_Name_n_Extension(sourcedb) If Right(targetdb, 1) <> "\" Then targetdb = targetdb & "\" End If targetdb = targetdb & extn Set accessApplication = New Access.Application With accessApplication .SysCmd 603, sourcedb, targetdb End With Set accessApplication = Nothing End Function Public Function db_Name_n_Extension(db_name_n_path As String) As String Dim db_Extension As String Dim db_name As String db_Extension = Mid(db_name_n_path, InStrRev(db_name_n_path, ".") + 1) 'accdb or mdb db_name = Mid(db_name_n_path, InStrRev(db_name_n_path, "\") + 1) 'abc.accdb or abc.mdb db_name = Mid(db_name, 1, Len(db_Extension)) 'abc. If db_Extension = "accdb" Then db_Name_n_Extension = db_name & ".accde" ElseIf db_Extension = "mdb" Then db_Name_n_Extension = db_name & ".mde" End If End Function

شكراً للتوضيح ، تداخلت معي الأمور بعد البخور اللي استعملناه عشان الاستاذ ابو جودي

استاذي الكريم @Foksh المفصود هو المدة المتبقية لنهاية العقد من تاريخ هذا اليوم

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

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

شكرا استاذ على الرد ولكن المطلوب العكس هل يتفع هذه :

شكرا لك كثيرا ( Eng.Qassim) هذا ما اريده وشكرا لمن ساعدني منذ البدايه (Foksh) شكرا لكم على المجهود الرائع 🥰

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

إذن أخي المشكلة في إصدار الأوفيس لديك لهذا يجب أن يكون طلبك على قدر إمكانيات الإصدار المستخدم من طرفك!!!! هل جربت عرض الملفات في النسخة الأولى ام لا؟

ارسل مرفق بسيط اذا أحببت ، لنر أين المشكلة

الذي ارفقته لك عمل الأكسس ومن وجهة نظري الذي تطلبه ممكن بالوورد أ أكسل .

You can execute the code in the worksheet event but I think it is better to execute the code for once when you would like to change

ستجد عبارة اختر كأفضل إجابة اسفل كل مشاركة .. الهدف منها ارشاد رواد المنتدى بالإجابة الأفضل التي تجيب على سؤالك .. 🙂

لو سمحت ممكن ارفاق صورة للسطر الدي به الخطا مع دكر ما هو اصدار الاوفيس لديك على الجهاز مع العلم ان الملف يشتغل معي بشكل جيد وبدون ادنى مشكلة على نسخة 2021 اليك الرابط التالي https://streamable.com/x84gtp اليك حل اخر 'Private Sub UserForm_Initialize() 'في اخر الكود قم باستبدال الكود الاول بهدا Dim ws, List, tb2(), réf Set ws = PDF List = ws.Range("A2:B" & ws.[A65000].End(xlUp).Row).Value tb2 = Array(1, 2) réf = UBound(tb2) + 1 ' وهدا في حدث التيكست بوكس Private Sub Recherche_Change() a = "*" & Me.Recherche & "*" Dim j(): n = 0 For i = 1 To UBound(List) If List(i, 1) Like a Or List(i, 2) Like a Then n = n + 1: ReDim Preserve j(1 To réf, 1 To n) List(i, 2) = Format(List(i, 2), "dd/mm/yyyy hh:mm") c = 0 For Each k In tb2 c = c + 1: j(c, n) = List(i, k) Next k End If Next i If n > 0 Then Me.ListBox1.Column = j Else Me.ListBox1.Clear End Sub الملف بعد التعديل 4.xls

بالنسبة للمطلوب الأول تحتاج فقط لملاءمة الطباعة في صفحة واحدة فقط وأسهل طريق لها في نافذة معاينة قبل الطباعة أو من اعداد الصفحة وبالنسبة للأرقام فهي فعلا يتم جلبها لصفحة الطباعة تلقائيا بسبب وجود معادلات البحث وبالنسبة للتاريخ في صفحة الطباعة فهو مضبوط وإذا كنت تقصد في صفحة إدخال البيانات فاستعمل في خلية اليوم =TEXT(TODAY(),"b2dd") وفي خلية الشهر =TEXT(TODAY(),"b2mm") وفي خلية العام =TEXT(TODAY(),"b2yyyy") بالتوفيق

السلام عليكم ورحمة الله وبركاته نموذج سريع للبحث في القرآن الكريم يمكنك البحث فيه بالتشكيل او بدونه طلب من الاخ الحبيب ياسر خليل ملحوظة : ارجوا استخدام المرفق فقط لغرض البحث واستخراج المعلومة المرفق 2003 نموذج بحث سريع في القرآن الكريم.rar

بارك الله لك أخي الكريم عبد الله وإذا سمحت لي يمكننا زيادة سرعة البحث والتعامل مع الملف بهذه التعديلات البسيطة بانتظار رأيك ورأي الإخوة الكرام أعضاء أوفيسنا ملحوظة: تم حذف جميع الأزرار واستبدالها بضغطات تم تلوين الآية في الشيت نموذج بحث سريع في القرآن الكريم1.rar

السلام عليكم ورحمة الله وبركاتة دالـة ( VLOOK_Pic1 ) لعـرض الصـور من أى نـوع و أى حجـم طريقة الاستخدام ::: 1 -فى نفس فلدر الملف الخاص بك إنشئ قلدر باسم ( AllPic ) ضع فية الصور 2 - أنسخ كود دالة ( VLOOK_Pic1 ) من ملف الدالة الى الملف الخاص بك 3 - من قائمة ( إدراج / دالة ) وعند ظهور الصندوق الحوارى حدد الفئة ب ( معرفة بواسطة المستخدم ) 4 - ثم اختار دالة ( VLOOK_Pic1 ) فيظهر الصندوق الحوارى اكتب اسم الصورة او عنوان خلية تحتوى على اسم الصورة ( يجب ان يكون اسم الصورة بدون النهاية الخاصة بنوعها ) الدالة بها خطأ صغير ربما يمكن معالجته فى القريب إن شاء الله ( ولكنه غير مؤثر) والى اللقاء بإذن الله فى دالة ( VLOOK_Pic2 ) الثانية التى تتعامل مع الصور من داخل الملف المرفقات عبارة عن ::: المرفق الاول يحتوى على فلدر به ملف الدالة + فلدر به بعض الصور + ملف فارغ للتطبيق عليه _______________.rar المرفق الثانى عبارة عن ملف فيديو لطريقة استخدام دالة ( VLOOK_Pic1 ) VLOOK_Pic1.rar

السلام عليكم نموذج للدليل المحاسبي اربعة مستويات بالامكانيات التالية: 1- العمل على نموذج فارغ 2- اضافة حذف جذور(1-9) 3- امكانية اضافة 99 حساب للرئيسي وفروعة الاخرى نموذج للدليل المحاسبي ثلاثة مستويات شاهد المرفق 2003-2010 نموذج للدليل المحاسبي 4 مستويات.rar