اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

  1. ابو جودي

    ابو جودي

    أوفيسنا


    • نقاط

      4

    • Posts

      6997


  2. Foksh

    Foksh

    الخبراء


    • نقاط

      3

    • Posts

      2991


  3. kanory

    kanory

    الخبراء


    • نقاط

      2

    • Posts

      2310


  4. AbuuAhmed

    AbuuAhmed

    الخبراء


    • نقاط

      2

    • Posts

      1071


Popular Content

Showing content with the highest reputation on 12/28/24 in all areas

  1. السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) بالإشارة الى الموضوع الذي أعلنت عنه سابقاً في هذا الرابط هنا ، اسمحوا لي بأن أطرح هذه الفكرة الجديدة والتي تم تجربتها مراراً وتكراراً إلى أن خرجت بهذه النتيجة فيما يتعلق بموضوع التحديث الهوائي أو Online أو OTA ( Over-The-Air ) . الموضوع بداية بسيط جداً ولن يحتاج تعقيد في تنفيذ هذه الطريقة . حيث ما يلزمنا أولاً هو حساب على Google Drive ( لماذا ؟ = لأن 95 % من الأشخاص عندهم هذا الحساب ) . و حساب على موقع Dropbox ( لماذا ؟ = لأنه يعطينا امكانية التحميل برابط مباشر خلافاً في جوجل درايف ) وهو ما يميزه عن Google Drive . بناءً على ما سلف ، نبدأ شرح الخطوات والمتطلبات على بركة الله :- 1. سنحتاج جدول واحد مرفق وهو ( Settings ) ، ولا أنصح بالتلاعب به ما لم يكن على أساس صحيح ؛ ويحتوي على الحقول التالية :- الحقل Ver = رقمي = لتحديد الإصدار الحالي للنسخة الحالية في قاعدة البيانات الحالية. الحقل Link = نصي = لتحديد رابط الملف النصي الذي سيتم قراءة الإصدار الجديد منه ومقارنته مع قيمة الحقل Ver لتحديد ما اذا كان هناك نسخة جديدة أم لا . الحقل URLS = نصي = سيتم ادراج رابط التحميل للإصدار الجديد من خلال الكود تلقائياً. الحقل DBName = نصي = سيمكانك هنا من تحديد اسم قاعدة البيانات التي سيتم حفظ التحديث الجديد بها . وهنا لتسهيل فكرة اسم القاعدة القديمة واستبدالها بالنسخة الجديدة سيتم جلب القيمة تلقائياً . الحقل Auto_Check = نوع Yes/No = لتفعيل ميزة الفحص التلقائي للتحديثات ( فكرة شبيهة بتلك التي في أجهزة الجوال والمحمول عند تفعيلها يصلك إشعارك بوجود نسخة جديدة إن كانت الميزة مفعلة طبعاً ) 2. تحميل الإصدار الجديد على موقع Dropbox ونسخ رابط الملف ( مع التأكد أن الملف عند مشاركته قد تمت مشاركته للجميع - الموقع يجعلها قيمة افتراضية - ولكن للتأكيد ) . 3. ملف نصي واحد ( TxT. ) سميه ما شئت وهو ثابت غير قابل للتبديل ، ويكون محتواه ما يلي :- السطر الأول نضع رقم الإصدار الجديد . اي انه في الملف القديم لنفترض ان قيمة الحقل Ver = 0.1 . هنا في الملف النصي سنضع الإصدار الأحدث أي مثلاً ( 0.2 ). السطر الثاني نضع رابط النسخة الحديثة التي تم رفعها على Dropbox في النقطة السابقة 2 . أي انه سيكون لدينا ملف نصي يحتوي سطرين الأول رقم الإصدار الحديث والذي ستتم قراءته و مقارنته مع الحقل Ver في الإصدار الذي لدى العميل ، والسطر الثاني رابط النسخة الأحدث من دروب بوكس . 4. سنقوم برفع هذا الملف النصي على جوجل درايف ( السبب : دروب بوكس لم يدعم فكرة قراءة الملف النصي وجلب قيمة رقم الاصدار في السطر الأول لمقارنتها مع القيمة في النسخة التي لدى العميل في الحقل Ver ) . 5. ثم سنقوم بنسخ الرابط لهذا الملف النصي ومشاركته للجميع - أو بمعنى آخر لمن يملك الرابط - ولصقه في الجدول الثابت Settings في الحقل Link وهو هنا سيكون أيضاً قيمة ثابتة لن تتغير . أي أنك ستقوم بتغيير فقط رقم الإصدار في النسخة الجديدة في الحقل Ver . وإعادة رفع الملف النصي بعد تحديث قيمة رقم الاصدار الجديد فقط . طبعاً هنا بالإفتراض جدلاً وبعد تجربة متكررة أنه عندما تقوم برفع ملف موجود مسبقاً على أي موقع من ( جوجل درايف أو دروب بوكس ) فأن العنوان لهذا الملف لن يتغير لأنه سيتم استبدال الملف القديم بالجديد . ( وهي نقطة جيدة استفدنا منها لصالحنا ). 6. الآن الفكرة بشكل عام واضحة ولا تحتاج لتعقيد في الشرح ( وأي فكرة أو طريقة في البداية ستحتاج مرات معدودة لتصبح سهلة في تطبيقها عن ظهر قلب ) الآن وما هو مهم للجميع ، الكود التالي للمديول :- '********************************************** '*** *** '*** FFFFFF OOO KK KK SSSS HH HH *** '*** FF O O KK KK SS HH HH *** '*** FFFFF O O KKK SS HHHHHH *** '*** FF O O KK KK SS HH HH *** '*** FF OOO KK KK SSSSS HH HH *** '*** *** '*************** ( 28/12/2024 ) *************** Option Compare Database Option Explicit Public Function IsInternetConnected() As Boolean On Error GoTo ErrorHandler Dim xhr As Object Set xhr = CreateObject("MSXML2.ServerXMLHTTP.6.0") xhr.SetOption 2, 13056 xhr.Open "GET", "https://www.google.com", False xhr.send IsInternetConnected = (xhr.Status = 200) Set xhr = Nothing Exit Function ErrorHandler: IsInternetConnected = False If Not xhr Is Nothing Then Set xhr = Nothing End Function Public Function ConvertGoogleDriveLink(ByVal originalLink As String) As String On Error GoTo ErrorHandler Dim FileID As String If InStr(1, originalLink, "/d/") > 0 Then FileID = Mid(originalLink, InStr(1, originalLink, "/d/") + 3) FileID = Left(FileID, InStr(1, FileID, "/") - 1) ElseIf InStr(1, originalLink, "id=") > 0 Then FileID = Mid(originalLink, InStr(1, originalLink, "id=") + 3) If InStr(1, FileID, "&") > 0 Then FileID = Left(FileID, InStr(1, FileID, "&") - 1) End If End If If Len(FileID) > 0 Then ConvertGoogleDriveLink = "https://drive.google.com/uc?id=" & FileID Else ConvertGoogleDriveLink = originalLink End If Exit Function ErrorHandler: ConvertGoogleDriveLink = originalLink End Function Public Function CheckForUpdate() As Boolean On Error GoTo ErrorHandler Dim currentVer As Double Dim onlineVer As Double Dim xhr As Object Dim onlineContent As String Dim driveLink As String Dim contentLines() As String Dim updateURL As String Dim currentDBName As String currentDBName = CurrentDb.Name currentDBName = Mid(currentDBName, InStrRev(currentDBName, "\") + 1) currentDBName = Left(currentDBName, InStrRev(currentDBName, ".") - 1) CurrentDb.Execute "UPDATE Settings SET DBName = '" & Replace(currentDBName, "'", "''") & "'" currentVer = DLookup("Ver", "Settings") If Not IsInternetConnected() Then Forms!Frm_Index!Lbl_Load.Caption = "أنت تستخدم الإصدار: " & currentVer CheckForUpdate = False Exit Function End If driveLink = ConvertGoogleDriveLink(DLookup("Link", "Settings")) Set xhr = CreateObject("MSXML2.ServerXMLHTTP.6.0") xhr.SetOption 2, 13056 xhr.Open "GET", driveLink, False xhr.setRequestHeader "User-Agent", "Mozilla/5.0" xhr.send If xhr.ReadyState = 4 Then If xhr.Status = 200 Then onlineContent = Trim(xhr.responseText) contentLines = Split(onlineContent, vbCrLf) If UBound(contentLines) >= 1 Then onlineVer = Val(contentLines(0)) updateURL = Trim(contentLines(1)) If onlineVer > 0 Then If onlineVer > currentVer Then CurrentDb.Execute "UPDATE Settings SET URLS = '" & updateURL & "'" Forms!Frm_Index!Lbl_Load.Caption = " تحديث جديد متوفر الآن : " & onlineVer & " Ver - انقر للتحميل " Forms!Frm_Index!ImgUpdate.Visible = True CheckForUpdate = True Forms!Frm_Index!Tx_User.Enabled = True Forms!Frm_Index!Tx_Pass.Enabled = True Forms!Frm_Index!Tx_User.SetFocus Else Forms!Frm_Index!Lbl_Load.Caption = "أنت تستخدم أحدث إصدار : " & onlineVer & " Ver " Forms!Frm_Index!Tx_User.Enabled = True Forms!Frm_Index!Tx_Pass.Enabled = True Forms!Frm_Index!Tx_User.SetFocus End If End If End If End If End If Set xhr = Nothing Exit Function ErrorHandler: CheckForUpdate = False If Not xhr Is Nothing Then Set xhr = Nothing End Function Sub UpdateURLSAndOpenNewDatabase() Dim UrlValue As String, NameValue As String Dim TargetDb As DAO.Database Dim rs As DAO.Recordset Dim CurrentDbPath As String Dim NewDbPath As String CurrentDbPath = CurrentProject.Path & "\" & Dir(CurrentProject.FullName) NewDbPath = CurrentProject.Path & "\Data\Update.accdb" If Dir(CurrentProject.Path & "\Data\Update.Dll") <> "" Then Name CurrentProject.Path & "\Data\Update.Dll" As NewDbPath Else MsgBox "الملف Update.Dll غير موجود", vbCritical Exit Sub End If On Error GoTo ErrorHandler UrlValue = Nz(CurrentDb.OpenRecordset("SELECT URLS FROM Settings").Fields("URLS").Value, "") NameValue = Nz(CurrentDb.OpenRecordset("SELECT DBName FROM Settings").Fields("DBName").Value, "") If UrlValue = "" Or NameValue = "" Then MsgBox "خطأ في تحميل التحديث", vbCritical Exit Sub End If Set TargetDb = DBEngine.OpenDatabase(NewDbPath) Set rs = TargetDb.OpenRecordset("Settings", dbOpenDynaset) If rs.EOF Then rs.AddNew rs.Fields("URLS").Value = UrlValue rs.Fields("DBName").Value = NameValue rs.Update Else rs.MoveFirst rs.Edit rs.Fields("URLS").Value = UrlValue rs.Fields("DBName").Value = NameValue rs.Update End If rs.Close TargetDb.Close Shell "msaccess.exe """ & NewDbPath & """", vbNormalFocus Application.Quit Exit Sub ErrorHandler: MsgBox "حدث خطأ: " & Err.Description, vbCritical If Not rs Is Nothing Then rs.Close If Not TargetDb Is Nothing Then TargetDb.Close Exit Sub End Sub Public Function ExtractAttachmentFile() As Boolean On Error GoTo ErrorHandler Dim db As DAO.Database Dim rs As DAO.Recordset Dim rsAttach As DAO.Recordset2 Dim fld As DAO.Field2 Dim dataFolder As String dataFolder = CurrentProject.Path If Dir(dataFolder, vbDirectory) = "" Then MkDir dataFolder End If Set db = CurrentDb Set rs = db.OpenRecordset("Settings") If Not rs.EOF Then Set fld = rs.Fields("DBFiles") If Not IsNull(fld) Then Set rsAttach = fld.Value If Not rsAttach.EOF Then rsAttach.Fields("FileData").SaveToFile dataFolder & "\" & rsAttach.Fields("FileName").Value ExtractAttachmentFile = True End If rsAttach.Close End If End If CleanUp: If Not rs Is Nothing Then rs.Close Set rs = Nothing Set db = Nothing Exit Function ErrorHandler: ExtractAttachmentFile = False Resume CleanUp End Function وما يلي كود النموذج لجميع الأجزاء والمكونات داخله :- '********************************************** '*** *** '*** FFFFFF OOO KK KK SSSS HH HH *** '*** FF O O KK KK SS HH HH *** '*** FFFFF O O KKK SS HHHHHH *** '*** FF O O KK KK SS HH HH *** '*** FF OOO KK KK SSSSS HH HH *** '*** *** '*************** ( 28/12/2024 ) *************** Option Compare Database Option Explicit Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private bMessage20Displayed As Boolean Private bMessage35Displayed As Boolean Private bMessage50Displayed As Boolean Private LoginAttempts As Integer Dim TimeCount As Long Private Sub Btn_Quit_Click() Dim userResponse As VbMsgBoxResult userResponse = MsgBox("إغلاق النظام؟", _ vbYesNo + vbInformation + vbMsgBoxRight, "تأكيد عملية الإغلاق") If userResponse = vbYes Then DoCmd.Quit ElseIf userResponse = vbNo Then DoCmd.CancelEvent End If End Sub Private Sub Form_Load() ExtractAttachmentFile LoginAttempts = 0 Me.Caption = "Foksh - Officena.Net - 2025" DoEvents If Check_Auto = -1 Then Me.TimerInterval = 1000 Else Me.TimerInterval = 0 Me.Lbl_Load.Caption = "" End If End Sub Private Sub Form_Timer() Me.TimerInterval = 0 CheckForUpdate End Sub Private Sub ImgUpdate_Click() On Error GoTo ErrorHandler Dim userResponse As VbMsgBoxResult userResponse = MsgBox("التحديث الآن؟", _ vbYesNo + vbInformation + vbMsgBoxRight, "تأكيد عملية التحديث") If userResponse = vbYes Then UpdateURLSAndOpenNewDatabase ElseIf userResponse = vbNo Then DoCmd.CancelEvent End If ErrorHandler: Resume Next End Sub ما يتم تنفيذه عند استعمال الفكرة :- أولاً عند الفتح للمشروع سيتم استخراج ملف DLL مرفق داخل قاعدة البيانات . ثانياً عند اكتمال التحديث سيتم استبدال النسخة القديمة بالنسخة الجديدة ، وشأنه شأن أي عملية تحديث ؛ فإنك ستفقد النسخة القديمة كاملةً ( وهنا الحاجة الماسة لاعتماد فكرة تقسيم قاعدة البيانات ) . ملف الواجهة المرفق مفتوح المصدر 👈 [ Main.accdb ] * عذراً إن كانت طريقتي في العمل مزعجة أو غريبة نوعاً ما ، لكن هو طبعي 😅 . فماذا أفعل ؟؟!!
    2 points
  2. صحيح يختار الاجابة التي يرغب ولكنها قد لا تكون الافضل وربما تكون الاسهل من وجهة تظر مبتدئ اتفق معك وخصوصا ان البعض ينظرون للاسم والرتبة عند اختيار الاجابة لذا اعتقد ان اختيار افضل اجابة من قبل قليل الخبرة يجعل العديد يحجموا عن المشاركة حتى لو كان لديهم حلول افضل ومادام الشيئ بالشيئ يذكر فقد شاركت في موضوع لاحد الاساتذة وبينت وجود خطأ وباسلوب مهذب وتقديم حل بشكل اخر ولكني تعرضت لهجوم واتهام باني اتصيد الاخطاء بعدها اكتفي بالابتسامة في امور مشابهة اخيرا الامر يحتاج الى نقاش متأني وان كان من يملك زمام الامر قد ادلى بدلوه "قطعت جهيزة قول كل خطيب" الشايب
    2 points
  3. السلام عليكم جميعا اعتذر عن عدم الرد على اقتراحات او ردود بعينها فهناك اضافات كثيرة مفيدة من الاخوة و لكن ساحاول تلخيص الموقف سريعا كما يلي: أولا ، رجاء خاص من الجميع ، لا داعي للخروج بالحوار بعيدا عن الهدف منه، نحن هنا نناقش الافضل لعموم المستخدمين و ليس لصاحب السؤال أو من رد عليه و يرى اجابته احق من غيرها، و وأرجو عدم الانزلاق بالحوار بعيدا عن الهدف منه، فهدف النقاش هو تحقيق أقصى استفادة من حيث الصالح العام من هذه الخاصية محل النقاش. فلسنا فى صراع من وجعة نظره أصح ومن حكمه أفضل على الأمر، ولا من أخطأ ومن أصاب. فكلنا فى مركب واحد. ثانيا: لن نتمكن مطلقا فى الاتفاق العام على تقييم فى جميع الاحوال ، و فى بعض المواضيع قد يكون الأمر جليا ، و فى بعضها قد يصعب الحكم و تكون هناك اكثر من وجهة نظر، والأخوة المشرفين (و منهم انا) ليس من الضروري أن يتفق الجميع مع تقديرهم للأمر و لا أن يكون حكمنا صحيحا بنسبة 100% ، و نأمل من الجميع أن يعذرونا فى ذلك، و هذا أمر طبيعي ومتوقع، و فى حال الاختلاف مع تقدير من لديه الصلاحية يمكن مراسلته بلطف بالرأي المخالف، على ان لا يظن الطالب ان الاتفاق مع رأيه أمر واجب ، فكلنا بشر نصيب و نخطيء ، و قد يكون الحل فى النقطة التالية (ثالثاً) حل يرضي عدد من الاطراف وليس بالضرورة جميع الاطراف فى حالة المواضيع المختلف عليها. ثالثا: فكرة أكثر من اجابة سليمة حل منطقي و لكن سيتطلب تدخل برمجي يخرجنا من اطار الدعم الفني للشركة المنتجة، و هذا ما تجنبناه لفترة طويلة ، و هناك حل بديل ،و هو أنه فى حالات المواضيع الدسمة التي بها أكثر من حل مختلف على كون أيها أفضل هي ليس بالحالة العامة ، و يمكن التحايل فى هذه الحالة باضافة رد جديد به وصلات لكافة المواضيع التي تعتبر اجابات سليمة أو افضل اجابات و اختيار هذا الرد نفسه كافضل اجابة، خاصة فى المواضيع التي كانت محل لردود و نقاشات وحلول مختلفة، و قد تستحق هذه المواضيع هذه الخطوة الاضافية لأنها عادة ما تكون بها اضافات مميزة ومتنوعة. رابعا : المسمي بالنسبة لي مثله مثل أي موضوع طرح للنقاش ، لا اري عيبا فى تغييره طالما سيؤدي لفائدة اكبر أنا فقط أحاول توضيح أهمية هذا الخيار من وجهة نظري، و أنه على المدى الطويل أهم من اعتبارات رضا صاحب السؤال أو تقدير اصحاب الاجاباتـ
    2 points
  4. بارك الله في جهودك وجميع الأعضاء بلا إستثناء ثم نسأل الله العلي القدير ان يغفر لوالدينا وجميع موتى المسلمين الله أغفر لهم وارحمهم وآنس وحشتهم ووسع مدخلهم وأكرم نزلهم وأفرش لهم من فرش الجنة يارب
    1 point
  5. اقرأ هذا الموضوع .....................
    1 point
  6. جزاك الله خيرا ونفع بك ورحم الله والديك وأسكنهم جنات النعيم ...
    1 point
  7. اللهم نور له قبره وآنس وحشته ووسع مدخله، اللهمّ افسح له في قبره مدّ بصره، وافرش قبره من فراش الجنّة،اللهمّ احشره مع أصحاب اليمين، واجعل تحيّته سلامٌ لك من أصحاب اليمين
    1 point
  8. تفضل ..... Private Sub Command_Click() Call DeleteImageFiles DoCmd.Quit End Sub Sub DeleteImageFiles() Dim fso As Object Dim folderPath As String Dim file As Object ' تحديد مسار المجلد المطلوب folderPath = CurrentProject.Path & "\Data\QR_images\" ' التأكد من وجود المجلد If Dir(folderPath, vbDirectory) = "" Then MsgBox "المجلد غير موجود: " & folderPath, vbExclamation, "خطأ" Exit Sub End If ' إنشاء كائن FileSystemObject Set fso = CreateObject("Scripting.FileSystemObject") ' التحقق من الملفات داخل المجلد For Each file In fso.GetFolder(folderPath).Files ' التحقق إذا كان الملف صورة (حسب الامتداد) If LCase(file.Name) Like "*.jpg" Or _ LCase(file.Name) Like "*.jpeg" Or _ LCase(file.Name) Like "*.png" Or _ LCase(file.Name) Like "*.bmp" Or _ LCase(file.Name) Like "*.gif" Then ' حذف الملف file.Delete True End If Next file MsgBox "تم حذف جميع ملفات الصور بنجاح!", vbInformation, "عملية ناجحة" ' تحرير الكائنات Set fso = Nothing End Sub
    1 point
  9. اللهم نور له قبره وآنس وحشته ووسع مدخله، اللهمّ افسح له في قبره مدّ بصره، وافرش قبره من فراش الجنّة،اللهمّ احشره مع أصحاب اليمين، واجعل تحيّته سلامٌ لك من أصحاب اليمين
    1 point
  10. بارك الله فيك اخي kkhalifa1960 واسعدك الله في الدنيا والأخره ورحم الله والديك وهذا هو المطلوب و"اشكرك" واشكر كل القائمين على هذا المنتدى ادام الله اعماركم بالبركة
    1 point
  11. تفضل استاذ @Mr-X المرفق بعد التعديل . . جرب ووافني بالرد .واذا كان هذا طلبك اضغط على أفضل اجابة . بحث بجميع الحقول وحالة الاحرف (111).rar
    1 point
  12. لو ان الموضوع مهم دعنى اعيد صياغة والية التصميم لاضفاء اكبر قدر ممكن من المرونة والاحترافية فى الاداء بقدر الامكان بس اعطنى وقتى لان الان انا مشغول جدا جدا جدا ولتعلم انه تم وضع الاجابة فقط بناء على رسالتكم معلش انا مشغول جدا جدا فى عملى لفترة لن تقل شهر
    1 point
  13. تدلل وتم تعديل المرفق لدعم النواتان 32, 64 علشان بعد كده محدش يقول لك انا لدى 64 بت كده محدش يبقال له حجه تانى تنويه انا لم اغير فى الية التصميم شئ لكن ممكن نستغنى عن مربع النص : str_Text ونضع التحقق التالى قى الكود If Len(Trim(Nz([CardNumber], ""))) = 0 Or Len(Trim(Nz([Date1], ""))) = 0 Then بدلا من If IsNull(Me.str_Text) Or IsEmpty(Me.str_Text) Or Len(Trim(Nz(Me.str_Text, ""))) = 0 Then وطبعا ممكن تستدعى الدالة : CreateAndDisplayQRCode عند اضافة سجل جديد فى الحدث بعد تحديث مربع النص الخاص بالتاريخ وكذلك رقم الهوية لضمان عمل الملف فى حالة تم ادخال بيانات اى حقل قبل الاخر والتعديلات بالاستغناء عن مربع النص : str_Text تجدها فى التعديل الثانى : zint QR 3- update (2) zint QR 3- update.zip zint QR 3- update (2).zip
    1 point
  14. موضوعك بسيط لا يحتاج إلى أكواد لكنه لم يكن واضح لي بشكل كامل وخصوصا باستخدامك مسلسل من 1 إلى 9 والتي توقعتها مضاعافات الساعة. توقيت البداية_03.xlsx
    1 point
  15. وعليكم السلام ورحمة الله تعالى وبركاته لم توضح أخي @علي بطيخ سالم هل الزيادة ستنفد على العمودين معا او الى فقط اليك محاولة مني بالاكواد لتثبيث الزيادة في عمود ( من) بساعة دائما وزيادة مدة الدقائق المدخلة في عمود (الى) Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim crWS As Worksheet: Set crWS = Me Dim tmp As Date, n As Double, lastRow As Long, i As Long If Not Intersect(Target, crWS.Range("A2,B2")) Is Nothing Then If crWS.Range("A2").Value = "" Or Application.WorksheetFunction.IsText(crWS.Range("A2").Value) Then _ MsgBox "يرجى إدخال توقيت البداية", vbExclamation: Exit Sub If Not IsNumeric(crWS.Range("B2").Value) Or _ crWS.Range("B2").Value <= 0 Then: MsgBox "يرجى إدخال مدة الزيادة بالدقائق", vbExclamation: Exit Sub tmp = crWS.Range("A2").Value n = crWS.Range("B2").Value / 1440 lastRow = crWS.Cells(crWS.Rows.Count, "E").End(xlUp).Row If lastRow < 2 Then Exit Sub Application.ScreenUpdating = False crWS.Range("C2:D" & crWS.Cells(crWS.Rows.Count, "C").End(xlUp).Row).ClearContents For i = 2 To lastRow If crWS.Cells(i, "E").Value <> "" Then crWS.Cells(i, "C").Value = Format(tmp, "hh:mm") crWS.Cells(i, "D").Value = Format(tmp + n, "hh:mm") tmp = tmp + TimeSerial(1, 0, 0) ' لتنفيد الزيادة بالدقائق على العمودين من و الى ' tmp = tmp + n End If Next i Application.ScreenUpdating = True End If End Sub في حالة الرغبة بتنفيد الزيادة على العمودين tmp = tmp + n توقيت البداية.xlsb
    1 point
  16. اخي @moho58 .. جرب هذا السلوك :- Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) On Error Resume Next Dim newKeyCode As Integer Select Case KeyCode Case vbKeyDown DoCmd.GoToRecord , , acNext Case vbKeyUp DoCmd.GoToRecord , , acPrevious Case vbKeyRight newKeyCode = vbKeyLeft KeyCode = newKeyCode Case vbKeyLeft newKeyCode = vbKeyRight KeyCode = newKeyCode End Select End Sub
    1 point
  17. حسب ما فهمته: توقيت البداية_02.xlsx
    1 point
  18. أهلا بكم.. من الصلاحيات الممنوحة للمراقبين الإداريين.. خاصية (التوصية بهذا الرد)، مع ذكر سبب التوصية في خانة الملاحظات. وبهذا يقع على المراقبين الإداريين اختيار الأفضل وتبرير سبب الإختيار.. ملاحظة: المراقبين الإداريين وصلوا إلى هذا المنصب بعد مدة من تصنيفهم كخبراء! هذه القصاصات تعرف بكيفية إختيار التوصية بالرد
    1 point
  19. اتفق مع استاذ @أبو إبراهيم الغامدي❤️🌹 بعد اذن استاذ @محمد طاهر عرفه ❤️🌹 تأشير على الرد الموصى به من جهة الاخبر منه لا انصح بتنوع التأشير يكون تأشير واحد فريد ويعدد من 1 الى 5 او 10 في الموضوع فحدد اما ان يكون التوجية او مرفق والكود يفضل مرفق والكود فقط يرفق التأشير بالتعميم والاعلان من تاريخ اليوم الى سبعة ايام ويزيد بتحديث التأشير *************************************************************************** '======================================= ( راس الموضوع ) اضافة تحديث الموضوع بارقام كأرقام تصفح الموقع السابق والتالي في رأس الموضوع استاذي @ابو جودي❤️🌹☕ يحدث الرأس الموضوع + تاريخ اضافة + تعميم براس المواضيع بسطر واحط فقط باجمالي التعميميات الجديد في التحديثات موضيع مختلفة على السبيل المثال 6 تثبيتهم حتى لو شهر بما تراه مناسب '========================================( نوع الطلب ) كان سؤال او اهداء هنا يحدد اضافة تفريع براس الموضوع '=========================================( ازالة صورة الكأس واجراء ) اذا حدد صاحب السؤال عشوائية الرد كأفضل اجابة يمنع في هذا الموضع والمشاركة المحدد تأشير في هذا الموضوع فقط احتمال اختيار العشوائي بسبب الوقت او اثبات امر آخر بنسبة لصاحب السؤال '==========================================( سمات التأشير ) خيار انتقال الى التأشير او قرائة عامة عند دخول المستخدم الى الموضوع او قبل الدخول اختيار الاجابة الموصى بها يحق اضافة رد داخل الرد الموصى به من قبل الاداري بالتوجية وملاحظات قبل الاخذ بالرد الموصى به ويحق للاداري اضافة هذا الاهداء الى مكتبة الموقع مع تأشير على الموضوع '===========================================( اضافة اساسية ) نوع السؤال 1- كان واحد او اكثر ويأخذ ببناء الطلب -نموذج -تقرير -تصميم جداول -دوال -ميكرو -كود - شجرة 2- جهة الموضوع باحث فيها السؤال - عام ويخصص للاهداء - مصانع - خدمات - مدارس -طبي -قانوني .... 3- استخدام القيم - تواريخ - جمع ومعادلات في الجدول او الفورم - ترحيل وتنفيذ اجراءات - حساب وقت او حسابات اخرى -تصحيح اخطاء '==================================( يطبق بالاهداء مع التعديل ) '=========================================================( النتائج ) لا يوجد فوضى بالتأشير وتكسيد الردود بالتحديث فوق بعض وممكن ضم الردود تطوير طريقة البحث من ومن ومن مع الجمع ************************************************************************************************************** اضافة جديد خلها تحت الدراسة - المستخدمين احتمال يكرر السؤال فنخلق جهتين 1- مواضيع المستخدمين مع التكرار 2- مواضيع ثابتة وتحدث فقط بالموصى به في نفس الموضوع بالحلول المختلفة والمصححة يعني راس الموضوع واحد فريد ===============( احتمال بعد سنوات حذف المكرر للسؤال بما احتفظنا بافضل اجابات موصى بها بالتحديث)
    0 points
×
×
  • اضف...

Important Information