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

وهذه مشاركتي بعد اذن استاذي أبو خليل . تشفير-1.accdb

المواصفات والقيود لا تزيد اخى

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

نسخة تجريبية للعميل _ تشفير لوقت محدد السلام عليكم اخوتي الكرام : احببت ان افرد العمل بعنوان مستقل ليكون قريبا للباحث وكنت وعدت بطرح مثالي المفتوح في موضوع سابق هنا وعندما راجعت مثالي بعد انقضاء الفترة تبين لي وجود ثغرات ، فقمت باصلاح الخلل وتجربة المثال اكثر من مرة للتأكد من عمل الأكواد على اكمل وجه . الفكرة : تحديد تاريخين من قبل المبرمج يتم تشفيرهما ، ولن يعمل البرنامج الا بين هذين التاريخين فقط بهذه الطريقة اغلقنا الطريق على من يحاول تغيير تاريخ الجهاز بعد انقضاء فترة التجربة والاتفاق على شراء البرنامج يتم ارسال نسخة دائمة الى العميل . يجب تقسيم قاعدة البيانات الى واجهات وجداول من اجل الحفاظ على بيانات العميل التي تم ادخالها خلال التجربة . ختاما ؛ اليكم الاكواد الخاصة مع المرفق دعواتكم ،،، 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

تفضل أخي محاولتي وبالاستعانة بكود أجنبي ووافني بالرد . DDTest114.accdb

اهلا بك معلمى العزيز وشيخنا الجليل ابوخليل وحبيبى فالله ، انت تعلم جيدا باننى طالب علم ولست باستاذ واتعلم منك ومن اخوانى واساتذتى جزاكم الله عنا كل خير 💐 افكارى نابعه من افكاركم وتعليمكم لنا الحيره ترافقنا جميعا وقت العمل فى ترتيب الافكار وتنفيذ الفكره ويسعدنى دائما مشاركتكم فى توصيل وشرح افكاركم فمنها اتعلم ولعلى انول دعوه معكم تنفعنى فى حياتى او يوم لاينفع مال ولا بنون سعدت بسعادتك معلمى العزيز ابوخليل ووفقك الله لما يحبه ويرضاه ، اللهم آمين تقبل تحياتى معلمى العزيز ابوخليل اخوك وابنكم الصغير 😀 احمد

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

السلام عليكم ورحمه الله وبركاته جزاك الله خيرا اخى ومعلمى وشيخنا الجليل على هذه الهديه 💐 واسمح لى بتعديل بسيط ليستطيع اخواننا بالتجربه قمت باضافه نموذج اخر للسماح لهم باضافه التواريخ واضافه يومان لتاريخ النهايه واستعمال الماكرو لفتح نموذج التسجيل فى حاله كان الجدول فارغ تقبل تحياتى ومرورى تشفير_1.accdb

يحتاج الباحث كثيرا إلى استخراج النصوص المميزة إلى ملف آخر مع أرقام الصفحات للنظر فيها بشكل مستقل، وهذا ماكرو لذلك: Dim oRng, oNrng As Range Dim oSource, oDoc As Document Dim oTable As Table Dim iRow, iPage, ILen As Integer Dim iPara, iIst, iLast As Integer Dim sFont, SComp, sNext, sWords As String Dim sColor As WdColor Set oSource = ActiveDocument Set oDoc = Documents.Add Set oTable = oDoc.Tables.Add(oDoc.Range, 2, 2) With oTable .Cell(1, 1).Range.Text = "النص المميز" .Cell(1, 2).Range.Text = "الصفحة" '.Cell(1, 3).Range.Text = "Font" لاستخراج اسم الخط '.Cell(1, 4).Range.Text = "Comments" لاستخراج لون التمييز With .Rows(1).Range .ParagraphFormat.Alignment = _ wdAlignParagraphCenter .Font.name = "Arial" .Font.Size = "12" .Bold = True End With End With oSource.Activate With Selection .HomeKey Unit:=wdStory With .Find .ClearFormatting .Replacement.ClearFormatting .Text = "" .Highlight = True .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False Do While .Execute = True Set oRng = Selection.Range With oRng iIst = .Start - .Words.First.Start + 1 iLast = .Words.Last.End - .End sNext = .Next.Characters(1) sColor = .HighlightColorIndex If .Start <> .Words.First.Start Or _ .End <> .Words.Last.End - 1 And _ sNext <> "" Then Select Case sNext Case ",", ".", "?", "!", ":", ";" SComp = "" iLast = iLast + 1 Case Else SComp = "Partly highlighted" End Select Else SComp = "" End If .Start = .Words.First.Start .End = .Words.Last.End If .Characters.Last = Chr(32) Then .End = .Words.Last.End - 1 End If sFont = .Font.name If Len(sFont) < 1 Then sFont = "Mixed fonts detected" iPage = .Information(wdActiveEndPageNumber) iRow = oTable.Rows.Count oTable.Cell(iRow, 1).Range.FormattedText = oRng.FormattedText oTable.Cell(iRow, 2).Range.Text = iPage oTable.Cell(iRow, 2).Range.ParagraphFormat.Alignment _ = wdAlignParagraphCenter 'oTable.Cell(iRow, 3).Range.Text = sFont لاستخراج اسم الخط 'oTable.Cell(iRow, 4).Range.Text = SComp لاستخراج لون التمييز oTable.Rows.Add End With Loop End With End With oTable.Rows.Last.Delete oDoc.Activate Beep End Sub

الأخ كريم شكرا لك ولا مانع من التنوع وذلك لزيادة الفائة وإثراءا للموضوع

السلام عليم ورحمه الله وبركاته استاذ @أبو إيمان ارجوا ان تسمح لمشاركتكم بالجواب كود للظهار Private Sub CommandButton1_Click() ActiveWorkbook.Application.DisplayFullScreen = False ActiveWorkbook.Application.CommandBars("FULL SCREEN").Visible = True ActiveWorkbook.Application.CommandBars("WORKSHEET MENU BAR").Enabled = True ActiveWorkbook.Application.CommandBars("STANDARD").Visible = True ActiveWorkbook.Application.CommandBars("FORMATTING").Visible = True ActiveWorkbook.Application.DisplayStatusBar = True ActiveWorkbook.Application.DisplayFormulaBar = True End Sub كود للاخفاء Private Sub CommandButton2_Click() ActiveWorkbook.Application.DisplayFullScreen = True ActiveWorkbook.Application.CommandBars("FULL SCREEN").Visible = False ActiveWorkbook.Application.CommandBars("WORKSHEET MENU BAR").Enabled = False ActiveWorkbook.Application.CommandBars("STANDARD").Visible = False ActiveWorkbook.Application.CommandBars("FORMATTING").Visible = False ActiveWorkbook.Application.DisplayStatusBar = False ActiveWorkbook.Application.DisplayFormulaBar = False End Sub قد اخذت هذه الاكواد من المضوع ادناه وهذا للافاده والاكواد مرفقه في المرفق New Folder.rar

وعليكم السلام ورحمة الله وبركاته لاخفاء شريط الصيغة Application.DisplayFormulaBar = False إليك هذا الكود يخفي جميع الاشرطة ويجعل الوضع ملء الشاشة ويقوم بإخفاء تبويب أوراق العمل لاحظ الصفحة المراد أن تفتح عليها ( يمكن وضع الكود في حدث فتح المصنف _ الملف _ ) Range("a1").Select Application.ScreenUpdating = False Dim ws As Worksheet Sheet1.Visible = xlSheetVisible For Each ws In ThisWorkbook.Worksheets If Not ws.Name = "اكتب هنا اسم الصفحة التي تريد ظهورها اول شيء" Then ws.Visible = xlSheetVeryHidden Next ws ActiveWindow.DisplayHeadings = False Application.DisplayFormulaBar = False Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",false)" Application.ActiveWindow.DisplayWorkbookTabs = False

الامر يسير .. نضع معيار حسب تاريخ التسديد الذي يعتبر تاريخ اليوم هنا لن يظهر ما تم تسديده في تاريخ سابق ، وايضا يسمح باظهار اكثر من سجل واحد تم تسديدها الآن printfactur3.rar

تم حل الموضوع من موقع اخر شكرا ComboBox2.Text = Replace(ComboBox2.Text, " ", "*")

لا لم انسى لاكن هدا ما فهمت من رسالتك الاخيرة على العموم تم اظافة المطلوب في المرفق التالي sella_V2.xlsm

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

وعليكم السلام ورحمة الله تعالى وبركاته يمكنك استخدام المعادلة التالية =IF(LEFT(TRIM(B2);1)="1";"س";"ج") ملف.xlsx

السلام علكيم الجزئية دي مسؤولة عن الاسم e3اما هنا تكتب الاسم في .SaveAs2 Filename:=MyPath & "\" & myBook.Sheets(MySheet).Cells(MyRow, 5) & ".doc", FileFormat:=wdFormatDocument .SaveAs2 Filename:=MyPath & "\" & myBook.Sheets(MySheet).Cells(2, 1) & ".doc", FileFormat:=wdFormatDocument في الخليه2 A يعني ممكن نكتب الاسم في عمود ِِ .Cells(2, 1) .... ورقم 2 يعني خلية رقم 2....A هنا رقم 1 يعني عمود

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

مشكورا اخي الكريم

h جعله الله فى ميزان حسناتك

انا عن نفسي اتمني ذلك اخي الفاضل الكريم

الاستاذ/ اغيد مرفق لكم مثال به حقل رقمى وحقل تاريخ مربوطين بجدول وبناءا على اكواد الاستاذ/ احمد والاستاذ / قاسم اعتقد انه المطلوب ملاحظة بعد ادخال البيانات فى الحقل اضغط انتر جزاكم الله خيرا two text date and no.accdb

وحده وحده عليه اخي الحبيب وافني بالشرح لتلميذك المبتدأ

وانا كذلك بسبب هذا المرفق قمت بالبحث عن السبب وتوصلت الى هذه النتيجة هذه لقطة من مقال المصدر : مايكروسوفت لذلك فإن accDE الخاص بـ x32 accDE و x64 خاصان جدًا بحجم النواه والبنية التي تم تجميعهما بها ويجب أن تعمل الأجهزة المستهدفة بنفس حجم النواة لاستعمال accDE الذي تم إنشاؤه باستخدامه ولا توجد استثناءات لهذه القاعدة ولذلك على كل مصمم ببساطة عند محاولة تشفير قاعدته الى accDE بمجرد تجميعها لابد من إنشاؤها مره باستخدام office (Access) x64 و إنشاؤها مره أخرى باستخدام office (Access) x32 للاسف الشديد حتى لا تحدث مشكلة عند العملاء بأختلاف أنوية الأوفيس.

هذا هو المرفق معدل _ اعبث بتاريخ جهازك كيف شئت 2010 _ 32 بت من دون الاستعانة بالانترنت تشفير فترة زمنية.rar

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

اثناء تصفحى فى المتتدى وجدت هذا الشيت الرائع الجميل وهو يعتبر بمثابة المطلوب لكم ولكنى لم انتبه الى اسم صاحب الشيت حتى نشكره ترحيل من الاكسيل الى ورد.rar

هذه تخضع لذوق الكاتب،، وأنا أستخدم للعنوان وتذييل الاسم والتوقيع MCS Jeddah S_U normal. وللسلام DecoType Naskh Variants وللختام DecoType Naskh Swashes وللبيان Khalid Art bold نحو

السلام عليكم تم تعديل آلية الترقيات السابقة ، حيث تم اضافة شرط لعدد نقاط الاعجاب لتنفيذ الترقية الالية ، كما هو مبين أدناه الدرجة الحالية المشاركات نقاط االاعجاب عضو جديد 01 50 - 02 الأعضاء 100 10 03 عضو مميز 500 50 04 عضو فضي 1000 100 05 عضو ذهبي 1000 500 06عضو ماسي 1000 1000 عند وصول نقاط الاعجاب الي 1000 للعضو الماسي سيتم الترقية الي مجموعة أعضاء الشرف و التي تضم أيضا المكرمين من ممن لهم مساهمات خارج الموقع و ستتغير الدرجة بالترقية للأعلى بعد اول مشاركة للعضو ، و لن يتم تخفيض أي درجات حالية. و تبقي مجموعات الخبراء و فريق الموقع و فريق الموقع السابق و أعضاء الشرف دون تعديل كما سيتم قريباً بإذن الله استحداث درجة خبير مخضرم لتكون الترقية التالية لدرجة خبير و سيتم الاعلان قريبا عن موعد تطبيقها و آلية التطبيق

أثناء مروري بأحد المواضيع في منتدانا الطيب ومن خلال المشاركات كان لأخي الحبيب أبو أحمد - عبدالله المجرب ، تعليق وطلب لشرح تركيب جملة SQL ، .... http://www.officena....=0 ومنها راودتني نفسي أن أجهز سلسلة لشرح ما يفتح عليّ ربي عن SQL ، وقد باشرت بالعودة لمراجعي ومواقعي المعتمدة ، وما لدي من ملاحظات و ( خرابيش ) في كشكولي ، وعقدت العزم ووجهت النية ... لوجه الله تعالى ، لا أبتغي منكم أجراً ولا (مديحاً) ، إن أجريَ إلا على الله ، وهو حسبي ، وهو المستعان . ورغم أن لغتي الإنجليزية ممتازة (أدعي) ، إلا أنني قررت الاستعانة بإبني البكر آدم في بعض الترجمات الفنية ، تخفيفاً على نفسي ، وتكثيفاً للجهد ، فأعينونا بالدعاء. راجياً من المولى عزّ وجلّ أن يعيننا على الخير ، وهو المستعان بحق وجزاؤه المرتجى ... والله من وراء القصد ... وهو حسبي ........................

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