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

السلام عليكم ورحمة الله وبركاته ,, الاخوة الكرام كل عام وحضراتكم بخير موضوعنا اليوم جديد وقد يهم الكثير من مستخدمى الاكسس , من المعروف ان الاكسيس يمكنه ضغط ملف او فك ضغطه باستخدام اوامر الشل الخاصة بالويندوز كما لو انك استخدمت الخاصية الموجودة فى الصورة وفى رأيى لا يمكن الاستفادة منها بهذا الشكل وبالتالى قمت بتصميم برنامج .Net يتكامل مع برنامج الاكسيس ويقوم بالتالى : 1- ضغط ملف / مجلد وحمايته برقم سرى . 2-فك ضغط ملف مضغوط برقم سرى . نبذة عن منطق التصميم والبرمجة : كان من الطبيعى انى اقوم بانشاء جدول او اكثر فى الاكسيس لحفظ البيانات المطلوبة ومسارات الملفات واقوم بقراءتها بالبرنامج الجديد ولكن فكرت فى طريقة اكثر احترافية وهى عمل المطلوب بالكامل فى الاكسيس وتمرير المسارات والارقام السرية من متغيرات VBA الى Arguments الخاصة بالبرنامج الجديد وكانت النتيجة جيدة بفضل الله . يتم فتح البرنامج عن طريق هذا الكود : Call Shell("""" & MyApp & """ """ & Operation & """ """ & strSource & """ """ & strDest & """ """ & zipPwd & """", 1) حيث يتم تمرير نوع العملية اولا وذلك لأن البرنامج يقوم ب3 وظائف , وبالتالى نوع العملية تقوم بتوجيه البرنامج للوظيفة المطلوبة ثم بالمسارات والباسوردات الخاصة بها سواء ضغط او فك ضغط يقوم بترجمتها بمعرفته . انظر للامثلة المرفقة : مثال لضغط ملف وحمايته بباسورد بضغطة زر وبكل سهولة وسرعة : مثال لفك ضغط الملف بالمثال السابق : ملحوظة : بالنسبة للامتداد الذى يتعامل معه البرنامج هو zip فقط وبالتالى لن يصلح لباقى الصيغ . اعذرونى ملحقتش اعمل تصميم جذاب ولكن المهم الفكرة . بالاضافة الى ان اكواد VBA يمكن اختصارها وتحسينها بواسطة الاساتذة . مرفق برنامج الاكسيس + البرنامج المساعد .. طبعا الموضوع متعوب عليه المطلوب فقط دعوة فى هذه الايام المباركة جزاكم الله خير . فى انتظار آرائكم ومقترحاتكم بعد التجربة .. دمتم بخير Zip-UnZip Access Amr Ashraf.rar

وعليكم السلام-لابد من رفع الملف نفسه لوضع المعادلة تماماً فى المكان المخصص لها وتجنباً لإهدار الوقت ... ويمكن هذا بمعادلة Date ... ,وبما انك لم ترفع الملف فيمكنك وضع المعادلة بنفسك فى المكان المخصص لها طبقا لملفك والخلايا المعلومة لك والمجهولة بالنسبة لنا =Date(Year,Month,Day)

عرفانا للجميل، وردا لبعض ما استفدته من هذا المنتدى المبارك، أقدم لإخواني (ماكرو تشكيل آلي) أستفيد منه كثيرا في مجال التشكيل، وهو عبارة عن ماكرو يقوم بالتالي: 1- ينسخ الكلمة أو الكلمتين، أو أكثر حسب تحديد الباحث، ثم يبحث بها في ملف آخر مشكول. 2- إذا وجد النص الذي يبحث عنه، فإنه ينسخه ويرجع إلى الملف غير المشكول، ليقوم باستبدال كل الكلمات غير المشكولة، فيضع مكانها المشكولة. 3- إذا لم يجد ما يبحث عنه، رجع إلى الملف ونسخ النص التالي ليبحث عنه، وهكذا. 4- يقوم بتلوين الكلمات المشكولة باللون الأحمر. 5- وفي نهاية العمليات يحفظ الملف بشكل آلي. 6- والمطلوب: أن تفتح ملف آخر مشكول ليبحث فيه الماكرو، فمثلا إذا كنت تشكل كتابا في الفقه فعليك أن تفتح ملفا آخر لكتاب فقه مشكول لينقل منه. 7- يجب أن تسمي الملف الذي تنقل منه التشكيل برمز معين، وليكن مثلا (----). 8- عند تشغيل الماكرو تخرج رسالة بعدد الكلمات المطلوب تشكيلها + 1 ، يعني لو أردت تشكيل كلمتين، فاكتب (3)، وإذا أردت تشكيل (4) اكتب (5)، وهكذا 9- والرسالة الثانية عدد مرات التكرار، يعني تكرر الأمر 100 مرة، أو 200، أو 1000، وهكذا. 10- والرسالة الثالثة فيها تحديد المدة، فيمكن أن تحدد المدة بالدقيقة، فلو كتبت (1) فهذا يعني أن الماكرو يعمل لدقيقة ثم يقف، ولو كتبت (2) فسيقف بعد دقيقتين، وهكذا. وهذا هو الماكرو لمن أراد: Sub تشكيلآلي() ' ' تشكيلآلي Macro 'ماكرو يشكل كلمات ملف من ملف آخر مشكول، بشرط فتح الملفين في آن واحد، وعند تشغيل الماكرو تختار عدد الكلمات المراد تشكيلها، كما تختار عدد مرات تكرار ذلك في الملف 'تمت إضافة تحديد الوقت في هذا الماكرو، فإذا كتبت (1) في مربع الوقت فهذا يعني دقيقةواحدة، وإذا كتبت(2)فهذايعني دقيقتين، وهكذا Dim X, a, b, c, y As Integer Dim t As Date t = Now Dim startTime As Date startTime = Now Do k = (InputBox("اكتب عدد الكلمات + 1")) X = (InputBox("اكتب عدد مرات التنفيذ")) y = (InputBox("حدد مدة تشغيل الماكرو بالدقيقة")) For i = 1 To X Selection.MoveRight unit:=wdWord, count:=1, Extend:=wdExtend If DateDiff("n", startTime, Now, endTime) = y Then ' s =عدد الثواني ' n =الدقائق ' h =ساعة MsgBox "تم تشكيل الكلمات وتلوينها باللون الأحمر" & Format(Now - t, " والوقت المستغرق = h:n:s ") Exit Do Exit Sub ActiveDocument.Save End If If (Len(Selection.Text) - 2 > 0) Then If Selection.Find.Found = False Then Windows(2).Activate Selection.MoveRight unit:=wdCharacter, count:=1 End If Selection.MoveLeft unit:=wdCharacter, count:=1 Selection.MoveLeft unit:=wdWord, count:=1 Selection.MoveLeft unit:=wdCharacter, count:=1 Selection.MoveRight unit:=wdWord, count:=k, Extend:=wdExtend a = Selection.Text Windows(1).Activate Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = a .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute If Selection.Find.Found = False Then Windows(2).Activate Selection.MoveRight unit:=wdCharacter, count:=1 Else b = Selection.Text Windows(2).Activate Selection.MoveRight unit:=wdCharacter, count:=1 Selection.Find.ClearFormatting Selection.Find.Replacement.Font.Color = wdColorRed With Selection.Find .Text = a .Replacement.Text = b .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = True .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute replace:=wdReplaceAll Selection.MoveRight unit:=wdWord, count:=1 End If End If Next i Beep MsgBox "تم تشكيل الكلمات وتلوينها باللون الأحمر" & Format(Now - t, " والوقت المستغرق = h:n:s ") Exit Do Exit Sub Loop ActiveDocument.Save End Sub

عليكم السلام ورحمة الله وبركاته للحصول على الاسم الأول يمكنك استعمال هذه المعادلة =LEFT(N14,FIND(" ",N14)-1) وللحصول على الاسم الأخير يمكنك استعمال هذه المعادلة =RIGHT(N14,LEN(N14)-FIND("*",SUBSTITUTE(N14," ","*",LEN(N14)-LEN(SUBSTITUTE(N14," ",""))))) تم تدمج الحلايا الثلاث في خلية واحدة التي بها الرقم والاسم الأول والاسم الأخير =aj1&" "&aj2&" "&aj3 وتكون هذه هي خلية اسم الشيت بالتوفيق

الحقيقة اعتذر لكوني لم ادخل للموقع ولم اشاهد الرد ☝️ علما بانه منذ فترة لم تعد تصلني اشعارات على الايميل ! ولكن في جميع الاحوال لن اقدم حل بجمال ماقدم الاساتذة @ابو البشر والاستاذ الخبير @Amr Ashraf وان كانت فكرتي تجزئة الكود والاستغناء على الاستعلام مع ذلك اقول بان مشكلة الاستعلامات مع حقل مرفق هي اقل مشاكل هذا النوع من الحقول لكون قاعدة البيانات access حجمها محدود بـ 2 جيجا شاملة مكونات القاعدة نفسها وهذا النوع من الحقول سوف يتسبب في زيادة حجمها بشكل كبير وقد يؤدى الى توقفها عن العمل وهنا قمت بتجربة تكرار تحميل ملف وقد قفز حجم القاعدة من 2.5 ميجا الى اكثر من 300 ميجا هذا امر والامر الاخر قاعدة بيانات اكسس قاعدة علائقية وعمل العلاقة بشكل صحيح بين الجداول يغني تماما عن تكرار البيانات في الجداول ولا اريد ان اضع امثله حتى لا اطيل لذا من وجهة نظر مبرمج سابق الاستغناء عن حقل مرفق واستبدالة بوضع الملفات بمجلد بجانب القاعدة وفي الجدول نستخدم حقل نصي لربط المرفق بالمعرف وتوجد العديد من الامثلة في الموقع وكما سبق ان اشرت في مشاركات سابقة هي مجرد نصيحة غير ملزمة وليس الهدف نقد اي عمل تحياتي

تمام انا مجربه فعلا بالطريقة اللى شرحتها اضافة سجل ثم الانتقال لحفظ السجل وعمل بشكل جيد , عامة المهم تم الحل بالتوفيق

السلام عليكم ورحمة الله تم إضافة زر للفورم خاص لحفظ كشوف الصفوف المختارة في الفورم بصيغة PDF باسم "الصف المختار"... أرجو أن يفي الغرض المطلوب... كشوفات الطلبة.xlsm

حاول في سجلات جديدة اقصد قم باضافة سجلات واترك السجلات القديمة لانها تم اضافتها وقت التجارب السابقة قبل الوصول للكود المطلوب ... والدليل ان السجلين الظاهرين لديك موجودين في جدول الاضافة لو اضفت سجل جديد يقوم البرنامج باضافة السجل الجديد ويهمل السجلات الملحقة للجدول سابقا ...

كيف ما وصلت لنتيجة ... بالعكس الكود والمرفق لدي يعمل على اكمل وجه ... والدليل يقوم بالحاق السجلات الغير موجودة في الجدول فقط الظاهر البشمهندس يتحدث بون تجربة للمرفق ... او انه فهم السؤال بطريقة اخرى

وهذه مشاركة وايضا حسب فهمي .... ههههههه ماذا لو استخدمنا وحدة نمطية تسهل على المبرمج اعادة وكتابة هذه الاكواد كلما احتاج اليها .... وايضا منعنا التكرار .... Public Function MoveData(FromTableName As String, ToTableName As String, Optional AttachmentFieldName As String = "No Attachment", Optional IgnoreAttachment As Boolean = True) On Error GoTo HandleErr Dim rstFromTable As DAO.Recordset Dim rstToTable As DAO.Recordset Dim fldFrom As DAO.Field2 Dim rstToAttach As DAO.Recordset2 Dim fldAttach As DAO.Field2 Dim rstFromAttach As DAO.Recordset2 Err.Clear Set rstFromTable = CurrentDb.OpenRecordset(FromTableName) Set rstToTable = CurrentDb.OpenRecordset(ToTableName) If (rstFromTable.BOF And rstFromTable.EOF) Then Exit Function End If Do While rstFromTable.EOF = False rstToTable.AddNew ' main add record For Each fldFrom In rstFromTable.Fields If fldFrom.IsComplex = False Then rstToTable(fldFrom.Name).Value = fldFrom.Value Else If AttachmentFieldName <> "No Attachment" Then rstToTable.Update rstToTable.Bookmark = rstToTable.LastModified rstToTable.Edit Set rstFromAttach = fldFrom.Value Set rstToAttach = rstToTable(fldFrom.Name).Value If rstFromAttach.RecordCount > 0 Then If IgnoreAttachment = False Then Do While rstFromAttach.EOF = False rstToAttach.AddNew For Each fldAttach In rstFromAttach.Fields If (IsNull(fldAttach.Value) = False) And (fldAttach.Name <> "FileType") Then rstToAttach(fldAttach.Name).Value = fldAttach.Value End If Next 'fldAttach rstToAttach.Update rstFromAttach.MoveNext Loop End If End If End If End If Next fldFrom rstToTable.Update rstFromTable.MoveNext Loop rstFromTable.Close rstToTable.Close ExitHere: Set rstFromTable = Nothing Set rstToTable = Nothing Set rstFromAttach = Nothing Set rstToAttach = Nothing Exit Function HandleErr: Select Case Err.Number Case 53 Err.Clear Resume Next Case 91 Err.Clear Resume Next Case 3020 Err.Clear Resume Next Case 3021 Err.Clear Resume Next Case 3022 Err.Clear Resume Next Case Else Debug.Print "Error " & Err.Number & ": " & Err.Description End Select Resume ExitHere End Function الحاق البيانات.accdb

السلام عليكم ورحمة الله وبركاته .. وبدون مقدمات 🙂 يطيب لي أن أضع بين يديكم برنامج ( مكتبة الأكواد الخاصة ) كان الهدف من تصميم البرنامج أن يخدمني بشكل خاص وذلك لحفظ الأكواد التي أحتاجها بشكل دائم وتجميعها في مكان واحد وتسهيل عملية البحث والوصول إليها بكل سهولة .. والبرنامج به تجميعة طيبة من الأكواد بعضها مما أبدعه الشباب هنا وبعضها مما صنعتها بنفسي ومنها من مواقع مختلفة .. والآن أحببت أن أشارككم بها وأن تعم الفائدة للجميع 🙂 البرنامج طبعا مفتوح بأحلاسه وأقلاسه ( بنماذجه وأكواده ) 😁 ويوجد فيه خاصية البحث ، وإدراج مرفقات (خارجية طبعا ) ومتاح للتطوير والتعديل والزيادة وتطويعه حسب احتياجاتكم .. 🌹 :: ولا تنسوني من صالح دعواتكم :: Pleeeeeeeeeeeeeeese 😄🤲🌷🌹 (واجهة البرنامج) (نافذة تفاصيل الكود) أعتقد البرنامج ما محتاج شرح واضح وضوح الشمس 😁 ::والتحميل في المرفقات :: مكتبة الأكواد الخاصة.accdb

ذكريات و تحديث اذاعات البث المباشر تحديث المرفق اعادة تفعيل الـ Shift تقليل حجم مستوى الصوت عتج الفتح ازالة روابط اذاعات بث الغناء اخص بكل الشكر والعرفان بالجميل اخى الحبيب الاستاذ @Amr Ashraf لتنبيهى لتدارك خطأى عبر نشر اذاعات بث الغتاء اللهم انى استغفرك واتوب واليك اللهم اغفر لى يارب وارحمتى واعفو عنى يارب العالمين Radio (V2).mdb

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

فكرة جميلة وعجبتنى حقيقة 🙂 بس ياريت كنت تحذف الاغانى والمهرجانات اللى فيه دى عشان متشيلش ذنب اى حد هيسمع منه 😊 تسلم ايدك

بعد إذن حبيبنا @Ali Mohamed Ali هذه محاولة لعرض تقرير الغياب الشهري لجميع الأقسام بصورة يمكن طباعتها بعد إخفاء الأعمدة الفارغة بالتوفيق تقرير غياب الموظفين في شهر.xlsx

كل عام وانت بالف خير استاذ ابو الحسن عملت في البداية استعلام توحيد بين الصرف والتحصيل لكل مصادر التمويل ثم عملت استعلام يجمع بين الصرف والتحصيل qrySum الذي يعتبر مصدر السجلات للنموذج الان عملت لك لكل مصدر تمويل ..يعني عندما تختار عميل جديد1 سيظهر لك في النموذج مجموع الصرف والتحصيل واسف على التاخير لاني نسيت واشتغلت على الملف المضغوط وضاع شغلي😢 جرب الان ووافني بالنتيجة TestLOck.rar

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

وعليكم السلام اخي ابو الحسن جمعت لك الحسابين ليظهر في النموذج مجموع واحد ..اما اذا اردت ان تظهر الحسابين معا فأجعل مصدر السجلات للنموذج من استعلام التوحيد qrySum2Balance TestLOck.rar

تسلم استاذ / محمد ربي يسعدك ويحفظك

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

فكرة سيطة وتنفيذ ولا أروع

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

السلام عليكم ورحمة الله وبركاته , كل عام وحضراتكم بخير مشاركة مع الاخوة على حسب فهمى لطلبك , بالنسبة لمنع التكرار عملت مفتاح اساسى فى الجدول رقم 2 ليمنع قبول السجلات المكررة . بالتوفيق الحاق البيانات(Amr).accdb

وعليكم السلام حاول تغيير اعدادات اللغة والمنطقة

يا سلام عليك ..لقد وصلت لنص الطريق اخي @مبرمج سابق بصراحة الموضوع جديد علي في كيفية الحاق المرفقات .. لكن كما قال الاستاذ @حامل المسك حين ادخال سجل جديد تظهر رسالة خطأ اعتقد نحتاج لاستعلام حذف البيانات القديمة عند الالحاق مجرد اقتراح .. والا لا علم لي الا ماعلمني الله سبحانه

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

بارك الله فيك اخي الكريم وجزاك الله خيرا يارب ويديك الصحة والعافية

السلام عليكم ورحمة الله تم التعديل على الماكرو بعد إضافة "أمر الطباعة" (طباعة الكشف لكل صف يتم اختياره في الفورم) ليعمل الماكرو على عدة صفوف (أقسام)... كشوفات الطلبة.xlsm

@kanory تفضل يا استاذنا تم حل مشكلة اللغة العربية Zip-UnZip Access Amr Ashraf .rar

جميلة وممتعة واذا دمجناها مع افكارنا فى الاكسيس النتيجة بتكون خرافية أيش رايك تشاركنا تجربتك في قسم ال #C بالمنتدى ؟ أنا أيضا عندي توجه لتعلم هذي اللغة 😊 لعل الله يحيي القسم على يديك 😁👌🏻

ذكريات الزمن الجميل… من المبدع الأجمل ابو جودي👍

يمكنك استعمال دالة sumifs للجمع باكثر من شرط في الخلية D6 =SUMIFS(Data!D:D,Data!C:C,C6,Data!A:A,">="&$C$4,Data!A:A,"<="&$E$4) بالتوفيق

بارك الله فيكم أخانا الكريم.

الملف مع تجربه المعادلة تجميع تاريخ.xlsx

السلام عليكم اخي ابو سارة حل جميل و كلام صحيح 100% ولكن انا فهمت السؤال بشكل مختلف اخي فتح الله وهذا الحل المرفق باستخدام التصفية التلقائية وتم وضعة في حدث تغيير الصفحة بحيث بمجرد ادخال اول احرف و الضغط على انتر تظهر النتائج المطلوبة Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row = 1 Then Range("A1:A2222").AutoFilter Field:=1, Criteria1:=[a1] & "*" End If End Sub آمل ان يكون هذا المطلوب مع التحية AY__________________________.rar

السلام عليكم تفضل الملف المرفق الخلية A1 تحتوي علي تاريخ اليوم للجهاز بمجرد كتابة أي بيان في أية خلية من خلايا العمود B سينسخ التاريخ (قيمة الخلية A1 ) في الخلية المجاورة (العمود C) جرب وأخبرني ssss.rar