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

السلام عليكم ورحمة الله وبركاته 🌹 بكل فخر وسعادة، تتقدم إدارة منتديات أوفيسنا وكافة أعضائها الكرام بأحرّ التهاني والتبريكات للأخ العزيز فادي @Foksh بمناسبة ترقيته إلى درجة مشرف 👏🎖️ لقد أثبت حضورك وجهودك الملحوظة في دعم الأعضاء وتقديم الفائدة باستمرار، وكان لعطائك بصمة واضحة في رُقي المنتدى وتطوره 📈💡 ✨ نبارك لك هذه الترقية المستحقة، ونتمنى لك كل التوفيق والنجاح في مهامك الجديدة ضمن كوكبة الإشراف في فريق الموقع 🌟 🌟 أهلاً وسهلاً بك في فريق أوفيسنا، واثقين بأنك ستواصل تميزك وتألقك بإذن الله 🌈 مع أطيب التحيات والتقدير، إدارة منتديات أوفيسنا 💼🌟

وعليكم السلام ورحمة الله وبركاته .. جرب هذا التعديل أخي الكريم رصيد بنــــك الكويت.xlsx

@Moosak أخي الكريم، شكراً جزيلاً آمين بارك الله فيك وزادك من فضله ونفع بك وعفا عنك وعافاك @ابوخليل أخي الكريم، شكراً جزيلاً آمين اللهم تقبل أسئل الله العلي القدير أن ييسر لك الخير حيث كان ورزقك علماً نافعاً ينتفع به @Foksh أخي الكريم، شكراً جزيلاً بارك الله فيك، متشكر علي الكلام الجميل ده نفع الله بك وبعلمك وزادك من فضله @محمد طاهر عرفه الأستاذ الفاضل بارك الله فيك، شكراً جزيلاً أسعدكم الله جميعاً وبارك فيكم ورزقكم علماً نافعاً ينتفع به وجمعني بكم علي خير في جنات النعيم رفقة النبيين والصديقين والشهداء والصالحين وحسن أولئك رفيقا

الف مبروك استاذ @Ahmos الامر ليس مستغرب بل اني سبق ان اشرت وتوقعت ذلك في مداخلة مع احدهم منذ عام تحياتي

وعليكم السلام ورحمة الله تعالى وبركاته data.xlsx

السلام عليكم واستمرارا بتتبع والتنقيب عن الخبراء بين المشاركات ، اهدي لانفسنا الخبير @Ahmos. شكرا لك على عطاءك 🙂 جعفر

أنت كمان بتضحك حظك لإنى مش فاضى لك بس نكاش بنكاش والبادى أنكش ... وأنت اللى بدأت بئه انا مش فاهم انا بقول ايه شكلى وصلت لاخر السكة خلاص التكة خلصت اتفضل يا سيدى ذاكر وانبسط بما انك عاوز وحده نمطية وتحكم من خلالها بس مش هخليها زيك تخفى العناصر وخلاص لا هخليــ .... وهأتكلم كتير ما تشوف بنفسك المرفق فيه الـ 3 نماذج بتوعك زى ما هم بينفذوا نفس طلباتك بس .......... فى نموذجين تانين ووحدتين نمطيتين شوف انت بقه اللى فيهم وذاكر ولما ابقى أروق لك ونفضى نبقى نتشاكس الموضوع والمرفق : >--->> من هنا يا أستاذ @Foksh طبعا بعيدا عن التهريج والهزار والمزاح لا اقلل من الاجابة الاولى وهى قطعا وبالفعل الأفضل على الإطلاق والإجابة المباشرة ولكن لأن فعلا كان فكرة كنت شغال عليها بالصدفة وتقريبا كانت شبه منتهيه فى ترتيب الأفكار بس فؤش أفندى بقه لعب فى نفوخى قلت لا بقه لازم أنهى الفكرة بالشكل الأمثل وعلشان مرتبطه بالموضوع ده وهو تنفيذ حدث فى وقت محدد أو بين وقتين محددين حبت اهز الورد وأضحك مع أخى الحبيب فؤش أفندى بمناسبة أن دى أول مشاركه لى معه بثوبه الجديد وليكون الموضوع مرجعا لمن يهتم لمثل هذه الأمور المجنونه شويه شويه هتخلونا نعمل كود يعمل اللى بنفكر ونحلم بيه ده اللى ناقص بقه وتبقى كملت مش تقولوا لى كود يعمل اكتر من وظيفه أو وظائف متتعده فى وقت محدد أو فى عدة أوقات مختلفة من إجراء واحد مركزى ايه لعب العيال ده يا فؤش أفندى هههه وأنا مصدقت لاقيته لعب عيال قلت العب براحتى بقه بقالى كتير ما أفوت وأول ما أفوت اشوفك ما شاء الله لابس البدله الحمرا

نكش ينكش نكشا دى النتيجه

مبارك اخي فادي تستاهل كل خير و بجدارة

هههه ، انا لو كنت عاوز أفتح الباب للفضول أكتر ، كان اقترحت الفكرة دي مثلاً :- Private Sub Form_Load() On Error Resume Next Me.Alborg.Visible = (Time() <= #3:00:00 PM#) On Error GoTo 0 End Sub أما لو عاوز نفتحها بحري ونتوسع في الحديث ، فممكن نعمل الآتي :- في مديول لوحده كده بدون ما حد يزعجه :- Option Compare Database Option Explicit Public Enum ControlVisibility visible = 0 Hidden = 1 ErrorState = 2 End Enum Public Enum EventType Information = 0 Warning = 1 [Error] = 2 End Enum Public Function ShouldShowControl(Optional targetTime As Date = #3:00:00 PM#) As Boolean ShouldShowControl = (Time() < targetTime) End Function Public Function SetControlVisibility(frm As Form, ctlName As String, _ Optional targetTime As Date = #3:00:00 PM#) As ControlVisibility On Error GoTo ErrorHandler Dim ctl As Control Set ctl = frm.Controls(ctlName) If ctl Is Nothing Then SetControlVisibility = ErrorState Exit Function End If Dim visible As Boolean visible = ShouldShowControl(targetTime) ctl.visible = visible SetControlVisibility = IIf(visible, visible, Hidden) Exit Function ErrorHandler: LogEvent "Error setting visibility for " & ctlName, EventType.Error SetControlVisibility = ErrorState End Function Public Sub LogEvent(message As String, Optional msgType As EventType = EventType.Information) #If DEBUG_MODE Then Debug.Print Format(Now, "yyyy-mm-dd hh:mm:ss") & " [TimeBasedControl] " & _ Choose(msgType + 1, "INFO", "WARN", "ERR") & ": " & message #End If End Sub طبعاً هنقدر نستدعي الفكرة دي بشكل متعدد لأكثر من وقت وأكتر من هدف 😋 :- 1️⃣ الطريقة البسيطة الأولى :- Private Sub Form_Load() UpdateControlVisibility #7:00:00 PM# End Sub Private Sub Form_Timer() Static lastUpdate As Date If Now > lastUpdate + TimeSerial(0, 0, 30) Then UpdateControlVisibility #7:00:00 PM# 'هنا طبعاً الوقت اللي عايزه lastUpdate = Now End If End Sub Private Sub UpdateControlVisibility(targetTime As Date) Dim result As ControlVisibility result = SetControlVisibility(Me, "SendBtn1", targetTime) 'باللي انت عايزه SendBtn1 بدل اسم الزر If result = ErrorState Then MsgBox "فشل تحديث العنصر", vbExclamation + vbMsgBoxRight, "" End If End Sub 2️⃣ الطريقة الثانية :- Private mTargetTime As Date Private Sub Form_Load() mTargetTime = #8:45:00 PM# UpdateTimeDisplay UpdateControlVisibility End Sub Private Sub cmdSetTime_Click() Dim newTime As String newTime = InputBox("أدخل الوقت المطلوب (HH:MM:SS AM/PM)", "تعيين الوقت", Format(mTargetTime, "hh:mm:ss AM/PM")) If newTime <> "" Then If IsDate(newTime) Then mTargetTime = CDate(newTime) UpdateTimeDisplay UpdateControlVisibility Else MsgBox "تنسيق الوقت غير صالح", vbExclamation + vbMsgBoxRight, "خطأ" End If End If End Sub Private Sub UpdateTimeDisplay() lblCurrentTime.Caption = "الوقت الحالي: " & Format(Time, "hh:mm:ss AM/PM") & vbCrLf & _ "الوقت المستهدف: " & Format(mTargetTime, "hh:mm:ss AM/PM") End Sub Private Sub Form_Timer() Static lastUpdate As Date If Now > lastUpdate + TimeSerial(0, 0, 1) Then btnEvening.SetFocus UpdateTimeDisplay UpdateControlVisibility lastUpdate = Now End If End Sub Private Sub UpdateControlVisibility() Dim result As ControlVisibility result = SetControlVisibility(Me, "SendBtn1", mTargetTime) If result = ErrorState Then LogEvent "فشل تحديث عنصر التحكم", EventType.Error End If End Sub 3️⃣ الطريقة الثالثة ، وسأكتفي بدون ما نتوسع أكتر من كده 😅 :- Private Type ControlTimeSettings ControlName As String ShowBeforeTime As Date ShowAfterTime As Date End Type Private mControlSettings() As ControlTimeSettings Private Sub Form_Load() ReDim mControlSettings(2) With mControlSettings(0) .ControlName = "btnMorning" .ShowBeforeTime = #12:00:00 PM# .ShowAfterTime = #12:00:00 AM# End With With mControlSettings(1) .ControlName = "btnAfternoon" .ShowBeforeTime = #6:00:00 PM# .ShowAfterTime = #12:00:00 PM# End With With mControlSettings(2) .ControlName = "btnEvening" .ShowBeforeTime = #11:59:59 PM# .ShowAfterTime = #6:00:00 PM# End With UpdateControlsVisibility End Sub Private Sub Form_Timer() Static lastUpdate As Date If Now > lastUpdate + TimeSerial(0, 0, 30) Then UpdateControlsVisibility lastUpdate = Now End If End Sub Private Sub UpdateControlsVisibility() Dim i As Integer Dim currentTime As Date Dim shouldBeVisible As Boolean Dim result As ControlVisibility currentTime = Time() For i = LBound(mControlSettings) To UBound(mControlSettings) With mControlSettings(i) If .ShowAfterTime < .ShowBeforeTime Then shouldBeVisible = (currentTime >= .ShowAfterTime And currentTime < .ShowBeforeTime) Else shouldBeVisible = (currentTime >= .ShowAfterTime Or currentTime < .ShowBeforeTime) End If result = SetControlVisibility(Me, .ControlName, IIf(shouldBeVisible, #12:00:00 AM#, #11:59:59 PM#)) If result = ErrorState Then LogEvent "فشل تحديث عنصر التحكم: " & .ControlName, EventType.Error End If End With Next i End Sub Control Visibility.accdb

من باب النكاش مع اخى الحبيب @Foksh انا مبحبش اجاوب ع القد بالظبط لازم احط التاتش بتاعى ده كود ديناميكى علشان لو النموذج كان مفتوح اساسا قبل الوقت وطبعا لانى معقد باعمل حساب اى اخطاء وطبعا علشان موضوع ديناميكى ده يشتغل لازم ولابد وحتما : TimerInterval > 0 ' اسم التحكم المطلوب تغيير حالته Private Const strControlName As String = "Alborg" ' تفعيل الطباعة في نافذة Immediate لتتبع التنفيذ (يفضل تعريفه في وحدة عامة ) Public DebugMode As Boolean ' دالة تقوم بإرجاع الوقت الهدف بتنسيق موحد باستخدام TimeSerial Private Function GetTargetTime() As Date GetTargetTime = TimeSerial(15, 0, 0) ' الساعة 3:00:00 مساءً End Function ' التحقق مما إذا كان التحكم موجودًا في النموذج لتفادي الأخطاء Private Function ControlExists(ByVal strCtlName As String) As Boolean On Error Resume Next ControlExists = Not Me.Controls(strCtlName) Is Nothing On Error GoTo 0 End Function ' تحديث خاصية الظهور للتحكم حسب الوقت الحالي Private Sub UpdateControlVisibility() On Error GoTo Update_Error ' التأكد من وجود التحكم أولًا If ControlExists(strControlName) Then Dim bolShouldShow As Boolean bolShouldShow = (Time() <= GetTargetTime()) ' تغيير خاصية الظهور بناءً على الوقت Me.Controls(strControlName).Visible = bolShouldShow ' طباعة الحالة في نافذة Immediate إذا كان DebugMode مفعّل If DebugMode Then Debug.Print "Visibility of control '" & strControlName & "' set to: " & bolShouldShow & " at " & Now End If Else MsgBox "Control '" & strControlName & "' not found on the form.", vbExclamation, "Missing Control" End If Exit Sub Update_Error: MsgBox "An error occurred in UpdateControlVisibility: " & Err.Description, vbCritical, "Error" End Sub ' يتم استدعاء هذا الحدث عند تحميل النموذج لأول مرة Private Sub Form_Load() On Error GoTo Load_Error ' DebugMode = True ' تحديث حالة ظهور التحكم عند فتح النموذج UpdateControlVisibility Exit Sub Load_Error: MsgBox "An error occurred in Form_Load: " & Err.Description, vbCritical, "Error" End Sub ' يتم استدعاء هذا الحدث بشكل دوري إذا تم تفعيل Timer للنموذج Private Sub Form_Timer() ' تحديث حالة الظهور ديناميكيًا كل فترة UpdateControlVisibility End Sub

تفتح العديد من ابوب النكاش

حبيبي حبيبي .. ربنا يبارك فيك ممتن لكل من هنأني ، وأسأل الله أن يجعل هذه الترقية دافعاً لبذل المزيد ، وأن نكون جميعاً عوناً لبعضنا في سبيل العلم والمعرفة

يا هلا والله ... والله اشتقنا مبارك مبارك مبارك لنا نحن انضمامكم الينا

اخي فادي اهلا وسهلا بك ضمن فريق العمل ، وما ذلك عليك بغريب ، فقد كنت تمارس هذا الدور بدون اللقب 🙂 جعفر

الملف المرسل في مشاركة سابقة ممتاز و يعمل بكفاءة و يوزع عدد 2 ملاحظين في كل لجنة برجاء تجربتة و كتابة ملاحظاتك. قمت بتعديل عدد اللجان و الملاحظين ليتوافق مع اللجان عندك توزيع الملاحظين .xlsm

أشكر لكم تهنئتكم الكريمة ، وأسأل الله أن أكون على قدر الثقة ، وأن أقدم ما فيه النفع والفائدة للجميع . وأسأل الله أن يعينني على أداء هذه المسؤولية بما يرضيه ، ويحقق منفعة إخواننا وأخواتنا في المنتدى . ويسعدني وجود هذه الثقة التي منحتموني إياها بإنضمامي إلى نخبة من المشرفين والمعلمين الكبار الأفاضل .. الشكر موصول لكم على كلماتكم الطيبة ومشاعركم النبيلة ، وأسأل الله أن يجعلنا عند حسن الظن ، وأن يوفقنا لخدمة هذا الصرح المميز أشكرك معلمي الفاضل على ثقتكم وسائر القائمين على هذا المنتدى .. 🌻 الله يبارك فيكم جميعًا ، وأسأل الله أن يوفقني لأداء دوري الجديد بما يليق بكم وبالمنتدى الكريم .

الف . الف . مبروك @Ahmos تستاهل ... ومزيد من الابداع

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

الف مبروك اخي العزيز فادي .. وأهلا بك بين اخوانك

الف مبروك🌻 واهلا بك أخي فادي في فريق الموقع

الف ميروك 💐

أستاذنا @Ahmos .. مبااااارك لنا انضمامكم لهذه المسيرة التي نسأل الله أن نكون جميعاً أهلاً لها .. وأنت من الأشخاص المميزين الذين يستحقون هذا اللقب فعلاً ، لما تقدمه من عطاء مميز في مواضيعك الجميلة 💐💐💐💐💐

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

مبارك عليك المسمى أخي @Ahmos 🙂 وهو ليس عليك بجديد .. ومبارك علينا انظمامك لهذه القافلة المباركة .. 🌹 جعلك الله عطاء لا ينضب 🙂🤲

@شايب شكراً جزيلاً لك أخي الكريم بارك الله فيك أسئلك الدعاء بالتوفيق والسداد فالحمد لله والشكر له علي كل شي { سبحان الله وبحمده سبحان الله العظيم } أشعر اني مازلت هاوي مجتهد وصدقاً أجد فيكم الكثير من المعلمين الأفاضل ولكني سأعتز بهذه الترقية ولو لم أكن أستحقها 😁

الكود باضافة شرط اللون :- DoCmd.OpenReport "Y_N_Report", acViewPreview, , "ddate = #" & [DDate] & "# AND NOT IsNull(colour)", , Screen.ActiveControl.Caption

وعليكم السلام ورحمة الله وبركاته أسعدتني، بارك الله فيك فهي شهادة يعتز بها منكم أنتم الخبراء الحقيقين أسئل الله لكم التوفيق والنجاح

وشكرا جزيلا للخبير Ahmos 🙂

@Foksh أسعد الله صباحك آمين، وإياك أخي الكريم بالتوفيق @jjafferr صبحك الله بالخير

وعليكم السلام ورحمة الله وبركاته .. اتمنى أن لا يكون هناك أمور لم تأت على ذكرها 😅😅 جرب في حدث عند التحميل لأي نموذج يحتوي الزر المطلوب ، الكود التالي Private Sub Form_Load() If Time() > #3:00:00 PM# Then Me.Alborg.Visible = False Else Me.Alborg.Visible = True End If End Sub

وعليكم السلام ورحمة الله تعالى وبركاته جرب هل هدا ما تقصده Sub SAVERANGEPDF() Dim FilePath As String Dim filename As String 'filename = ActiveSheet.Name & "_" & Format(Now, "dd-mm-yyyy") & ".pdf" 'OR filename = ThisWorkbook.Name & "_" & Format(Now, "dd-mm-yyyy") & ".pdf" FilePath = Application.ActiveWorkbook.Path & Application.PathSeparator & filename Selection.ExportAsFixedFormat Type:=xlTypePDF, filename:=FilePath, _ Quality:=xlQualityStandard, IgnorePrintAreas:=False, OpenAfterPublish:=True End Sub

لقد ألقيت نظرة أكثر قليلاً على الكود الخاص بي ، وقمت بحساب عدد الملفات الموجودة بالفعل في المجلد. واكتشفت أنه إذا قمت بحذف أي من الإصدارات الأقدم، فسيخرج رقم الإصدار الجديد من المزامنة ولن يستخدم الرقم الأحدث. إذا كنت مهتم بتجربة إصدار آخر، فاستبدل هذا الرمز: ' ' تسلسل اسم الملف F = 0 Do While Cpt <> "" F = F + 1 Cpt = Dir Loop '(Excel بصيغة)' ' حفظ الملف في المسار التالي Application.ActiveWorkbook.SaveAs Filename:=a(3) & "\" & a(1) & "_" & F + 1 & ".xlsx", FileFormat:=51 بهذا الكود: ' تسلسل اسم الملف Dim sVers As String Dim Réf As Long, F As Long Dim i As Long Do While Cpt <> "" sVers = Right(Left(Cpt, InStr(Cpt, ".xls") - 1), 4) Réf = 0 For i = Len(sVers) - 1 To 1 Step -1 If IsNumeric(Right(sVers, i)) Then Réf = Val(Right(sVers, i)) Exit For End If Next i If F < Réf Then F = Réf Cpt = Dir Loop '(Excel بصيغة)' ' حفظ الملف في المسار التالي Application.ActiveWorkbook.SaveAs Filename:=a(3) & "\" & a(1) & "_" & F + 1 & ".xlsx", FileFormat:=51

تفضل اخي Sub SaveFile_Excel() Dim wb As Workbook, desWS As Worksheet Set wb = ThisWorkbook: Set desWS = wb.Sheets("الفاتورة ") Dim a(1 To 3) As String Dim shape As shape: Dim rng As Range 'اسم الملف a(1) = desWS.[D3].Value With Application .ScreenUpdating = False .DisplayAlerts = False On Error Resume Next 'اسم مجلد الحفظ قم بتعديله بما يناسبك a(2) = "Excel فواتير المبيعات" '***********'لحفظ الملف في نفس مسار المصنف الرئيسي********* ' a(3) = Application.ActiveWorkbook.Path & "\" & a(2) '*************لحفظ الملف في بارتيشن من اختيارك************* ' قم بتحديد اسم البارتيشن الخاصة بك a(3) = "D:\" & a(2) ' انشاء المجلد في حالة عدم العثور عليه If Dir(a(3), vbDirectory) = "" Then MkDir a(3) Cpt = Dir(a(3) & "\" & a(1) & "*") desWS.Copy Set rng = [B1:F22] With rng .Value = .Value: .Validation.Delete For Each shape In ActiveSheet.Shapes shape.Delete Next End With ' تسلسل اسم الملف F = 0 Do While Cpt <> "" F = F + 1 Cpt = Dir Loop '(Excel بصيغة)' ' حفظ الملف في المسار التالي Application.ActiveWorkbook.SaveAs Filename:=a(3) & "\" & a(1) & "_" & F + 1 & ".xlsx", FileFormat:=51 ' غلق المصنف ActiveWorkbook.Close DisplayAlerts = True .ScreenUpdating = True End With MsgBox "تم نسخ ملف " & " " & a(1) & " " & " بنجاح" & vbLf & vbLf & a(3) & _ "", vbInformation, "ملف رقم :" & " " & F + 1 End Sub لحفظ الملف بصيغة PDF قم بتعديل هدا السطر '(PDF بصيغة)' Application.ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=a(3) & "\" & a(1) & "_" & F + 1 حسابات احمد Excel & PDF.xlsm