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

بعد إذن الاستاذ محمد هشام a1 أول عمود فيه بيانات O اخر عمود فيه بيانات الاستاذ حيدر استبدل حرف O ب أخر عمود عندك وبحسب ما ذكرت سوف يكون AE Set MOSS = ws.Range("A1:AE" & lr)

اختلف الموضوع .. فضلا افتح موضوعا بعنوان جديد بطلبك

نسخة تجريبية للعميل _ تشفير لوقت محدد السلام عليكم اخوتي الكرام : احببت ان افرد العمل بعنوان مستقل ليكون قريبا للباحث وكنت وعدت بطرح مثالي المفتوح في موضوع سابق هنا وعندما راجعت مثالي بعد انقضاء الفترة تبين لي وجود ثغرات ، فقمت باصلاح الخلل وتجربة المثال اكثر من مرة للتأكد من عمل الأكواد على اكمل وجه . الفكرة : تحديد تاريخين من قبل المبرمج يتم تشفيرهما ، ولن يعمل البرنامج الا بين هذين التاريخين فقط بهذه الطريقة اغلقنا الطريق على من يحاول تغيير تاريخ الجهاز بعد انقضاء فترة التجربة والاتفاق على شراء البرنامج يتم ارسال نسخة دائمة الى العميل . يجب تقسيم قاعدة البيانات الى واجهات وجداول من اجل الحفاظ على بيانات العميل التي تم ادخالها خلال التجربة . ختاما ؛ اليكم الاكواد الخاصة مع المرفق دعواتكم ،،، Function EncryptDecrypt(strIn As String, strPass As String) As String Dim intLen As Integer Dim intCounter As Integer Dim varTmp As Variant Dim strTmp As String intLen = Len(strPass) strTmp = strIn For intCounter = 1 To Len(strIn) varTmp = Asc(Mid$(strPass, (intCounter Mod intLen) - intLen * ((intCounter Mod intLen) = 0), 1)) Mid$(strTmp, intCounter, 1) = Chr$(Asc(Mid$(strIn, intCounter, 1)) Xor varTmp) Next EncryptDecrypt = strTmp End Function Private Sub cmd1_Click() 'لإدراج التاريخ في الحقلين ثم تعديل الحقول يدويا حسب الفترة المطلوبة ' يستخدم مرة واحدة قبل التشفير Me.regEnd = Now() Me.regStart = Now() Me.Requery End Sub Private Sub cmd2_Click() ' تشفير الحقلين ولاحظ ان الزر يشفر ويفك التشفير في نفس الوقت Dim strPassword As String strPassword = "EnDecryptAccessOfficna" Me.regStart = EncryptDecrypt(Me.regStart, strPassword) Me.regEnd = EncryptDecrypt(Me.regEnd, strPassword) End Sub Private Sub Form_Current() On Error Resume Next Dim strRegStart, strRegEnd, vNowv As Date Dim strPassword As String vNowv = Now() strPassword = "EnDecryptAccessOfficna" strRegStart = EncryptDecrypt(Me.regStart, strPassword) strRegEnd = EncryptDecrypt(Me.regEnd, strPassword) 'عند العبث بالشفرة في اي من الحقلين If Not IsDate(strRegEnd) Or Not IsDate(strRegStart) Then MsgBox "تم التلاعب بالشفرة .. سيتم اغلاق البرنامج" DoCmd.Quit End If ' عند نهاية الفترة If vNowv > strRegEnd Then MsgBox "انتهت الفترة التجريبية .. تواصل مع المبرمج " DoCmd.Quit End If ' عند تغيير تاريخ الكمبيوتر لان النسخة المؤقتة ستعمل فقط بين التاريخين المرصودين If vNowv <= strRegStart Then MsgBox "تم تغيير تاريخ الجهاز .. سيتم غلق البرنامج " DoCmd.Quit End If End Sub تشفير.rar

الحقيقة ان التعامل مع الجدول اسهل من التعامل مع مربع القائمة كل ماهو مطلوب ان نعمل حلقة تمر على سجلات الجدول بشرط رقم ملف المريض ثم نعمل متغير نصي ياخذ قيمته من حقل Reportname ونستخدم المتغيير للتعويض عن اسم التقرير وتوجد طرق اخرى ولكن هذا مافكرت به ولكن كما اشار استاذنا الفاضل @ابوخليل هذا طلب مختلف ويتطلب له موضوع جديد

السلام عليكم ورحمة الله تعالى وبركاته اليك اخي حل اخر بالاكواد Sub test() Dim ws As Worksheet Dim MOSS As Range Dim lr As Long Set ws = Worksheets("ورقة1") Application.ScreenUpdating = False lr = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row Set MOSS = ws.Range("A1:O" & lr) For Each ColorCell In MOSS If ColorCell <> "" Then ColorCell.Interior.Color = RGB(220, 230, 241) Else ColorCell.Interior.ColorIndex = xlNone End If Next End Sub مسودة تحذف.xlsm

بعد اذنك أخي متقاعد ممكن أضيف زر تحديد وزر عدم تحديد الكل . Listbox-D11.accdb

Try this code Private f As Boolean Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) PopulateComboBox Me.ComboBox1 End Sub Private Sub UserForm_Initialize() f = False Me.ComboBox1.MatchEntry = fmMatchEntryNone PopulateComboBox Me.ComboBox1 End Sub Sub PopulateComboBox(ByVal cmb As MSForms.ComboBox) Dim arrIn, arrOut(), i As Long, j As Long With Sheets(1) arrIn = .Range("B2:B" & .Cells(Rows.Count, "B").End(xlUp).Row).Value End With ReDim arrOut(1 To UBound(arrIn)) For i = 1 To UBound(arrIn) If arrIn(i, 1) Like "*" & cmb.Text & "*" Then j = j + 1 arrOut(j) = arrIn(i, 1) End If Next i If j = 0 Then cmb.Clear: Exit Sub ReDim Preserve arrOut(1 To j) With cmb .Clear .List = arrOut If j > 0 And f Then .DropDown Else f = True End With End Sub

يتم كتابة تاريخ معين بدلا من now() ام يتم كتابة التاريخ بين القوسين تشفير.accdb

افتح القاعدة باشتخدام الشيفت على التصميم الكود واضح وعليه بعض الشروحات

سأقوم بعمل موضوع جديد وارفاق قاعدة البيانات عند عودتي من العمل جزاكم الله خيرااا

,وهذا مثالك بعد التعديل وراجع المكتبات به ويعمل عندي جيداً النتيجة 1401 Clock_DD11.accdb

اقصد ان الجهاز الاخر يحتوي على لوحة ام بمعالجين من نوع Intel® Xeon CPU Socket LGA 2066 و 12 شريحة رام ddr4 تدعم تصحيح الاخطاء "تستخدم مع اجهزة السيرفرات" وعند تجربة البرنامج لم يتعرف عليهما واعطى قراءة غير صحيحة ربما يكون لي عودة للتجربة مع اجهزة اخرى بعتاد مختلف عن الجهازين السابقين تحياتي

1)لم توضخ المطلوب جيدا هل هناك أسماء محددة تريد تغييرها. 2) هل التنفيذ على نطاق معين أو على الشيت بالكل Sub Replace() Dim sheet As Worksheet Dim Réf As Variant Dim val As String Dim y As Long Réf = Array("علي", "محمد", "احمد", "ضياء") val = "موظف" For y = LBound(Réf) To UBound(Réf) For Each sheet In ActiveWorkbook.Worksheets sheet.Columns("A:A").Replace What:=Réf(y), Replacement:=val, _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _ SearchFormat:=False, ReplaceFormat:=False Next sheet Next y End Sub لتنفيد الامر على جميع خلايا ورقة العمل يمكنك استبدال هذا الجزء من الكود sheet.Cells.Replace What:=Réf(y), Replacement:=val, _ LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _ SearchFormat:=False, ReplaceFormat:=False Next sheet Next y test.xlsm

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

وعليكم السلام... على الرغم من أن اللغتين تشتركان في بعض أوجه التشابه ، إلا أن بناء الجملة وهيكل الكود يختلفان. ستحتاج إلى إجراء تعديلات على الكود لجعله يعمل في كل تطبيق. الاثنان لهما بعض الوظائف المتداخلة. على سبيل المثال ، يمكن استخدام كليهما لإدارة البيانات وإجراء العمليات الحسابية وإنشاء التقارير. ومع ذلك ، فإن كل تطبيق له نقاط القوة الخاصة به وهو مصمم لتلبية الاحتياجات المختلفة. كمثال بسيط لتجميع حقلين في حقل واحد في اكسس Dim strConcat As String strConcat = Me.field1 & " " & Me.field2 بينما في اكسل Dim strConcat As String strConcat = Range("A1").Value & " " & Range("B1").Value

شكراً أستاذى

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

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

مرحبا بك استاذ محمد.. جمعت لك من هنا وهناك بما تريد ..لكن لم يظهر عندي نوع الرام وبصراحة ماطولت من (خلكي) في البحث ..ما اعرف بالمصري شنو معناها😄 Ram.rar

سوف تقوم بتحدد الخلايا ----- الضغط على conditional formatting ثم New Rule ثم اختيار format only cells that contain ثم equal to ثم اكتب ""= ثم اختار اللون الذي تريد ثم موافق

وعليكم السلام ورحمة الله تعالى وبركاته تفضل اخي جرب Sub Supprimer_la_ligne_en_double_B() Dim Rng As Range Dim X As Long Set Rng = Range("B2", Range("B" & Rows.Count).End(xlUp)) X = Rng.Rows.Count For X = X To 1 Step -1 With Rng.Cells(X, 1) If WorksheetFunction.CountIf(Rng, .Value) > 1 Then .EntireRow.Delete End If End With Next X End Sub حذف الفواتير المكررة.xlsm

السلام عليكم...كان هناك خطأ مطبعي والظاهر اني صححته والملف مضغوط فلم يأخذ التصحيح اليك الملف بعد التعديل..عدلت ايضا التنسيق بين الليبل والتكست ... واعتذر كثيرا على التأخير tesea.rar

يا أخي لتثبيت محتويات النموذج كلها : وليس إدى محتوياته طبق التالي : علم علي كل محتويات النموذج وهو في وضع التصميم وكليك يمين على أي من التحديد ثم (Enchoring) ثم اذهب لاعلى واختار (Top-Left) والله الموفق .

طريقة اخرى باستخدام for next Dim k As String Dim i As Integer For i = 0 To List2.ListCount - 1 If List2.Selected(i) = True Then k = List2.Column(0, i) DoCmd.OpenReport k, acViewPreview End If Next i الملف مرفق Listbox.accdb

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

استاذ سامر المحترم .. انا قضيت ساعتين لاصحح الكود تبعك ...وحسب منطوق سؤالك لديك الان كود بيعمل كويس ...افتح موضوع جديد بماتطلبه ..فربما لا استطيع على حله ويتدخل احد الاخوة الافاضل بصراحة بعد العاشرة مساء ..اشوف الخمسة سبعة 😃

امر اخير لماذا تتعب نفسك بكتابة اسماء التقارير في الليست بوكس وكلما اضفت تقرير تقوم باضافة اسمه بينما ممكن جعل مصدر الليست SELECT MSysObjects.Name FROM MSysObjects WHERE (((MSysObjects.Type)=-32764)); وهنا تجد ان اي تقرير تعمله تجد اسمه موجود تلقائي Listbox.accdb

جرب في زر الامر اكتب Dim k As Variant Dim r As String For Each k In Me.List2.ItemsSelected r = Me.List2.ItemData(k) DoCmd.OpenReport r, acViewPreview Next k الملف مرفق Listbox.accdb

اساتذتي الكرام .... بارك الله بجهودكم ومساعدتكم ... جزاكم الله عني كل خير

راجع الموضوع أدناه ⬇️ لعله يفيدك

اساتذتى وخبرائى الافاضل وأخص بالذكر الفاضل جعفر الذى ساعدني كثيرا في برنامج الأسنان كما أود أن اشكر ذاكراتة القوية ولي الفخر ان اعمل برنامج متواضع ينول إعجاب خبراء الفاضل من امثالكم شكرا لكل من مد يد العون لي طوال سنوات اشتراكي معكم في هذا الصرح التعليمي الكبير منذ 18 نوفمبر 2014 لكم الشكر جميعا

نعم اخي واستاذي @ابوبسمله..اتحاشى كثيرا استخدامها في الاستعلام بالنسبة للسجلات الكبيرة الحجم ..اما بالنسبة للمشاريع المحدودة فلا بأس بها