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

تفضل محاولتي أخي @jo_2010 Word.accdb

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

ما شاء الله تبارك الرحمن ..كل الافكار جميلة من الاساتذة الافاضل طريقة الاستاذ الفاضل @Foksh بعد اذنه Word.accdb

اسف تفضل Word (1) (1).accdb

احب ان اشكر الاستاذ العظيم @Foksh والاستاذ الفاضل @kkhalifa1960 على تعبهم بارك الله فيهما وجعلهم خير عونا لنا

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

جزاك الله كل خير أخي العزيز @Foksh تم حل المشكلة بارك الله فيك

In cell B15 put the following formulas and drag to left =INDEX(OFFSET($E6, 1, 0, 1, COLUMNS($E6:$BH6)), MATCH(B14, OFFSET($E6, 0, 0, 1, COLUMNS($E6:$BH6)), 0)) then select the range B15:F15 and copy the range and finally paste the formulas into cells B17 then B19

وهذه محاولتي أيضاً . الاكثر بيع.rar

هذه محاولتي أخي الكريم @الحلبي الاكثر بيع.accdb

تفضل أخي مرفك كنت سويته لأحد المشاركات لحساب عدد الكلمات والحروف لأي مقطع . DD440.rar

مشاركة مع أستاذى @Foksh MsgBox "Number Of Words: " & IIf(Len(Trim(Me.Text1)) = 0, 0, UBound(Split(Trim(Me.Text1), " ")) + 1) Or MsgBox UBound(Split(Trim(Me.Text1), " ")) + 1

اخي الكريم ، انق الكود إلى أي حدث تريده في النموذج أو التقرير ،، على العموم ، تفضل By date.accdb

تفضل هذا المثال ان شاءالله نفس ما تريد تغيير المسمى.accdb

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

وهذه محاولة التلوين لكن السعر الاول لوحده والسعر الثاني لوحده . محاولة للتقرب من الحل . DD440.rar

طيب يا استاذه @safaa salem5 المرفق شغال مع حضرتك تمام واللا فى مشاكل ؟ وهل ده المطلوب واللا لا

العفو اخي الكريم يسعدنا اننا استطعنا مساعدتك رغم انني اعتقد ان النسخة السابقة افضل لاكن هده اخر محاولة تم تغيير جميع الاكواد من على اليوزرفورم تمت التجربة على اصدار 2016 و 2010 وتمت العملية بنجاح . النسخة المعدلة.xls

الموضوع تعبنى جدا والله وكان تحدى صعب احب التنويه الى شئ استخدام 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

لو سمحت ممكن ارفاق صورة للسطر الدي به الخطا مع دكر ما هو اصدار الاوفيس لديك على الجهاز مع العلم ان الملف يشتغل معي بشكل جيد وبدون ادنى مشكلة على نسخة 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

تفضل اخي تم اظافة ورقة مخفية لعرض الملفات الموجودة داخل المجلد على الليست بوكس واستخراج وطباعة اسماء التقارير الغير مرفوعة 'Private Sub UserForm_Initialize() اظافة في nomPDF = "Tableau1" Réf = Range(nomPDF).Columns.Count List = Range(nomPDF).Resize(, Réf + 1).Value For i = 1 To UBound(List): Next i ''''''''''''''''''''''''''''''''' Private Sub Recherche_Change() ling1 = 1 ling2 = 2 clé = "*" & Me.Recherche & "*": n = 0 Dim Tbl() For i = 1 To UBound(List) On Error Resume Next If List(i, ling1) Like clé Or List(i, ling2) Like clé Then n = n + 1: ReDim Preserve Tbl(1 To 2, 1 To n) Tbl(1, n) = List(i, ling1): Tbl(2, n) = (Format((List(i, ling2)), "dd/mm/yyyy hh:mm")) End If Next i If n > 0 Then Me.ListBox1.Column = Tbl Else Me.ListBox1.Clear Counter = "عدد التقارير " & "/" & ListBox1.ListCount End Sub بالتوفيق.....🫡 الملف بعد التعديل 3.xls تقرير الحالات.rar

أخي الكريم ما الذي يمنعك من استعمال المعادلة أو الكود في ملفك لا حاجة لطلب ملف اكسل إذا كنت تريد أن تتعلم

بعد اذن اخواني في المنتدى هذا الكود البسيط الذي يعكس كل شيء (ارقام ونصوص) معادلة عكس الارقام salim.rar Function RevText(s As String) If Len(s) = 1 Then RevText = s Else RevText = RevText(Mid(s, 2, 99)) & Left(s, 1) End If End Function

السلام عليكم ورحمة الله وبركاته في الملف المرفق معادلة تقوم بعكس الارقام الموجودة في خلية , مثلا الارقام (123456) تعكس الى(654321) و المعادلة تعمل بصرف النظر عن عدد الارقام في الخلية. وضعت المعادلة في هذا الموضوع بسبب اني استفدت واخذت الفكرة الاساسية للمعادلة من المعادلات الموجودة في ملف اخي الفاضل الاستاذ بن علية تحياتي معادلة عكس الارقام.rar

السلام عليكم ورحمة الله أخي الكريم وهذا عمل آخر مختلف تماما عما سبق، قمت بتحضير نوع خط جديد سميته Inversed.ttf يقوم بقلب أي حرف أو رقم أو علامة بعد تطبيق هذا النوع عليها وتجد اسم الخط في قائمة الخطوط مقلوبا هو أيضا... في الملف المرفق تجد ملفين أحدهما هو نوع الخط يجب تنصيبه مع خطوط ويندوز والملف الثاني هو مثال تطبيقي على قلب الأرقام وقد استعملت معه دوال تقوم بكتابة الأرقام بالعكس (من اليمين إلى اليسار) (والحد الأعلى لأرقام العدد الذي تريد قلبه هو 6 أرقام)... أخوك بن علية قلب الأرقام بالخط.rar