AbuuAhmed

يبقى انتهاكا للحقوق وإن قام به الآخرون، وهو كذلك "انتهاكا" لقوانين الموقع، فكم من مواضيع قام المراقبون والمشرفون بإغلاقها وصد ناشريها، فلما تمارسونها؟! ممكن الموقع يقدم خدمات (مثلا) كإزالة كلمة مرور فقط لمالك برنامج بعد التثبت من ملكيته له، أما أكثر من ذلك فلا أراه صائبا.

لأسف الشديد بسبب موضوعكم هذا اضطررت لحذف برامجي العلمية المنشورة على الإنترنت والتي كانت ينتفع بها.

تنقيح أخير، أصبح فيه الكود سطر واحد فقط 🙂 Sub Date2Text() Range("B7", "AJ23").NumberFormat = "m-d" End Sub

تم تنقيح الكود سابقا لو ضغطت الزر أكثر من مرة فسوف يبدل النتائج مع كل ضغطة أما الآن سيبدلها مع الضغطة الأولى فقط. Sub Date2Text() Const sRow = 7, eRow = 23 Const sCol = 2, eCol = 36 Dim Row As Integer, Col As Integer Application.EnableEvents = False Application.ScreenUpdating = False For Row = sRow To eRow For Col = sCol To eCol With Cells(Row, Col) If .NumberFormat = "d-mmm" Then .NumberFormat = "@" If .Value <> "" Then .Value = Month(.Value) & "-" & Day(.Value) End If Else .NumberFormat = "@" End If End With Next Col Next Row Application.EnableEvents = True Application.ScreenUpdating = True MsgBox "Done" End Sub

بالأكواد من زر asc2Text_02.xlsm

تذكرت موضوع قديم، قد يسهم في إثراء الموضوع:

...

جرب هذا الخيار في قبل الطباعة: Page Setup -> Sheet -> Black and white

جرب احذف الأقواس

جمعت الحلين في مثال واحد واضطررت لحذف كل الأكواد المتعلقة بحل الأستاذ عسل قليل الدسم مع الاعتذار لمزيد من التركيز للسائلة. تجربة صادر_05.accdb

يمكن حلها كذلك بالأكواد إذا أردتها تظهر بتنسيق كما الوقت مع أن تنسيق الوقت لا يقبل أكثر من 24 ساعة. تقرير التأخير الشهري_03.xlsx

حل آخر تجربة صادر_04.accdb

للتجربة .. الحل هو المظلل بالأصفر إن شاء الله. تجربة صادر_03.accdb

موضوع شيق، ربما المشكلة ليست في الدوال، وتخميني أنك تحتاجين عمل Requery للنموذج الفرعي و ربما للرئيسي بعد كل عملية إضافة. أنا من فترة بعيد عن الأكسس، لو ترفعين مثال ستسهل عملية التجارب والمحاولات. الموضوع ليس بالصعب إن شاء الله. هل الحقل رقمي أم نصي؟ وإذا كان نصي هل لنا أن نعرف تنسيقه؟

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

تم تنقيح الكود لتسهيل التعديل عليه Private Sub Worksheet_Change(ByVal Target As Range) Dim Row As Integer, Col As Integer Dim fRow As Integer, fCol As Integer, fdd As Integer Dim yy As Integer, mm As Integer, dd As Integer Dim cellDate As Date, DateRange As String, m m = Array("", "يناير", "فبراير", "مارس", "أبريل", "مايو", "يونيو", _ "يوليو", "أغسطس", "سبتمبر", "أكتوبر", "نوفمبر", "ديسمبر") With Target DateRange = Replace(.Address, "$", "") If DateRange <> "M1" Then 'تبديل عنوان خلية التاريخ عند الحاجة' Beep 'MsgBox Exit Sub End If If Not IsDate(Range(DateRange)) Then Beep 'MsgBox Exit Sub End If Application.EnableEvents = False Application.ScreenUpdating = False yy = Year(.Value) mm = Month(.Value) For fdd = 1 To 7 If Weekday(DateSerial(yy, mm, fdd)) = vbSunday Then Exit For Next fdd End With Cells.Find(What:="الأحد", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate fRow = ActiveCell.Row fCol = ActiveCell.Column + 1 Cells(fRow - 2, fCol + 5) = m(mm) dd = fdd - 3 For Col = fCol To fCol + 9 Step 2 dd = dd + 2 For Row = fRow To fRow + 4 dd = dd + 1 cellDate = DateSerial(yy, mm, dd) If Month(cellDate) = mm Then Cells(Row, Col + 0) = cellDate Cells(Row, Col + 1) = 1 Else Cells(Row, Col + 0) = "" Cells(Row, Col + 1) = "" End If Next Row Next Col Application.EnableEvents = True Application.ScreenUpdating = True End Sub حساب_التاريخ_06.xlsm

حل آخر بالكود: Private Sub Worksheet_Change(ByVal Target As Range) Dim Row As Integer, Col As Integer Dim fRow As Integer, fCol As Integer, fdd As Integer Dim yy As Integer, mm As Integer, dd As Integer Dim cellDate As Date, m m = Array("", "يناير", "فبراير", "مارس", "أبريل", "مايو", "يونيو", _ "يوليو", "أغسطس", "سبتمبر", "أكتوبر", "نوفمبر", "ديسمبر") With Target If Not (Target.Row = 1 And Target.Column = 13) Then Exit Sub yy = Year(.Value) mm = Month(.Value) For fdd = 1 To 7 If Weekday(DateSerial(yy, mm, fdd)) = vbSunday Then Exit For Next fdd End With Cells.Find(What:="الأحد", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate fRow = ActiveCell.Row fCol = ActiveCell.Column + 1 Application.EnableEvents = False Application.ScreenUpdating = False Cells(fRow - 2, fCol + 5) = m(mm) dd = fdd - 3 For Col = fCol To fCol + 9 Step 2 dd = dd + 2 For Row = fRow To fRow + 4 dd = dd + 1 cellDate = DateSerial(yy, mm, dd) If Month(cellDate) = mm Then Cells(Row, Col + 0) = cellDate Cells(Row, Col + 1) = 1 Else Cells(Row, Col + 0) = "" Cells(Row, Col + 1) = "" End If Next Row Next Col Application.EnableEvents = True Application.ScreenUpdating = True End Sub حساب_التاريخ_05.xlsm

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

كما فهمت: Private Sub أمر0_Click() Dim msgRes As VbMsgBoxResult Const msg = "ماذا تريد ان تفعل Yes فتح نموذج NO فتح تقرير Cancel تراجع " msgRes = MsgBox(msg & vbCrLf & "" & vbCrLf & "الحمدلله", vbYesNoCancel + vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, "الله المستعان") '--- طريقة أولى ---- If msgRes = vbYes Then DoCmd.OpenForm "22" ElseIf msgRes = vbNo Then DoCmd.OpenReport "33", acViewPreview ElseIf msgRes = vbCancel Then Exit Sub End If '--- طريقة أخرى ---- 'Select Case msgRes ' Case vbYes ' DoCmd.OpenForm "22" ' Case vbNo ' DoCmd.OpenReport "33", acViewPreview ' Case vbCancel ' Exit Sub 'End Select '--------------- '... End Sub

ربما غايتك النتائج بتقويم أم القرى، إذا كان كذلك فاستخدم التنسيق الآتي لخلايا التاريخ الهجري: [$-1170000]B2dd/mm/yyyy;@

محاولتي =IF(F2="","",IF(F2<E2,"-","")&TEXT(ABS(F2-E2),"hh:mm")) TRIP_01.xlsx

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

جرب هذا الكود في حدث التغيير للصفحة إذا راقت لكم الفكرة فقوموا بالتعديل على الكود حسب الرغبة لا تنتطروني .. Private Sub Worksheet_Change(ByVal Target As Range) With Target If .Column = 22 And .Row >= 6 And .Row <= 9 Then If .Value = 0 Then .NumberFormat = "0;-0;;@" ElseIf .Value = Fix(.Value) Then .NumberFormat = "[$-2010401]0" Else .NumberFormat = "[$-2010401]0.00" End If Debug.Print .Address, .Value, .NumberFormat End If End With End Sub

أول خانة هي رمز القرن ويمكن علاجه بطريقة أفضل حسب وجهة نظري كالتالي: cy = (Left(MyNumber, 1) + 17) * 100 لتصبح النتائج كالتالي: 1700 0 1800 1 1900 2 2000 3 2100 4

سؤالك غير واضح، لو ترفع مثال وبمزيد من الشرح ستجد أكثر من عضو يشارك معك المحاولة.