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

اذا كنت تريد ان يظهر لك ما يحتوي التحديد الذي قمت به (بدون الخلايا الفارغة) استعمل هذا الملف الكود Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Selection.Cells(1, 1).Column = 1 Then Exit Sub If Selection.Cells.Count > 50 Then MsgBox "Too Many Data" Exit Sub End If Dim lasteRow Dim x% lasteRow = Cells(Rows.Count, 1).End(3).Row If lasteRow = 1 Then lasteRow = 2 If Application.CountA(Target) = 0 Then With Range("A1") .Value = Selection.Address With .Offset(1) .Resize(lasteRow, 1).Clear .Value = "Selection is Empty " .Interior.ColorIndex = 8 End With With .Offset(2) .Value = "ActiveCell is : " & ActiveCell.Address .Interior.ColorIndex = 3 .Font.ColorIndex = 2 End With End With Exit Sub End If Dim arr() Dim k%: k = 1 Dim cel As Range For Each cel In Selection If cel <> vbNullString Then ReDim Preserve arr(1 To k) arr(k) = cel.Value k = k + 1 Else: x = x + 1 End If Next With Me.Range("a1") .Value = Selection.Address .Offset(1).Resize(lasteRow, 1).Clear .Offset(1).Resize(k - 1, 1).Value = Application.Transpose(arr) With .Offset(k) .Value = "Active Cell is : " & ActiveCell.Address .Interior.ColorIndex = 3 .Font.ColorIndex = 2 With .Offset(1) .Value = "Items: " & Selection.Cells.Count - x .Interior.ColorIndex = 7 .Font.ColorIndex = 2 End With End With End With Me.Range("A:A").Columns.AutoFit Range("B1") = "Selection Address" Erase arr End Sub GET adderss of selection.xlsm

تفضل اخى الكريم -1تجربة.xlsx

نعم صحيح كما قال اخي وصديقي الحبيب صالح

السلام عليكم الخطأ سببه أنك وضعت كود يقوم بإغلاق نموذج data06 و هو يحمل التاريخ الأول والثاني جرب أحذف هذا الكود و جرب

لم انتبه لطلبك في المشاركة الاولى في حال تريد نقل أصناف محددة تحتاج الى عمل حقل في جدول رقم العهد ولنفرض انه : Chk واجعل نوع البيانات رقم ثم قم باضافته في النموذج الفرعي في ADD واستخدم هذا الكود تحت زر ADD Dim strSQL As String strSQL = "UPDATE [رقم العهد] " & _ "SET [الرقم العام] = myn,[التاريخ] = Date()" & _ "WHERE chk =true" DoCmd.SetWarnings False DoCmd.RunSQL strSQL DoCmd.SetWarnings True DoCmd.Requery

أخى الكريم حاتم قم بوضع هذا الكود فى حدث الورقة وليس فى موديول Private Sub Worksheet_SelectionChange(ByVal Target As Range) Range("A1").Value = ActiveCell.Value If ActiveCell = "" Then Range("A1").Value = ActiveCell.Address End If End Sub ولكم منى جزيل الشكر

المشكلة أستاذ حمدي كانت في ان الكود لا يتعرف على حقل التحرير والسرد انه فارغ Null تفضل: جرب هذا الكود Dim MyStringSql As String MyStringSql = "SELECT [Teacher Class].NAMEe " & _ " FROM [Teacher Class] " & _ "WHERE ([Teacher Class]." & Me.DDR & _ " Is Null Or ([Teacher Class]." & Me.DDR & ")="""")ORDER BY [Teacher Class].NAMEe;" Me.LST1.RowSource = MyStringSql Me.ff = Me.LST1.ListCount - 1 Me.LST1.Visible = True Me.Refresh

اهلا بك استاذ حاتم اخ كريم فى منتدانا تفضل لك ما طلبت كود لإظهار اسم الخلية النشطة في خلية أخرى.xlsm

اذا كنت تريد من اكسل المراتب بين 1 ومئة مثلا 1 الأوّل 22 الثّاني والعشرون وهكذا ..... حمل هذا الملف Salim's Order.xlsm

بكبسة زر واحدة نستطيع ان نعرف ما هو اخر صف غير فارغ في كل شيت انظر المرفق (Sheet1) Last_row In sheets.xlsm

السلام عليكم عندما أستعمل الأمر sendkeys لأحد مفاتيح لوحة المفاتيح يقوم بإغلاق زر تشغيل الأرقام لا أدري ما هو السبب في ذلك هناك بعض الحيل لتفادي هذا المشكل لكن لا تنجح دائما هل هناك تفسير او حل لهذه الظاهرة؟

العفو أخي

اتمنى ان يكون لنا فائدة هنا http://www.accesswordkingdome.com/forumarchive/forum/برنامج-مايكروسوفت-آكسس/البرمجة-وقواعد-البيانات/13598-هل-يصلح-الاكسيس-لتصميم-البرامج-الكبيرة؟ تحياتي

حلوة طلة الأحبة

السلام عليكم الكود التالي يمكنك من معرفة هل يوجد اختصار على سطح المكتب أو لا: Dim curPath As String curPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\tt.lnk" If Len(Dir(curPath, vbDirectory)) <> 0 Then MsgBox 1 Else MsgBox 0 End If اسم الاختصار هو tt إذا كان هناك اختصار تظهر رسالة بها 1 و إذا لم يكن هناك إختصار تظهر رسالة بها 0 جرب الكود و أطلعنا على النتيجة

السلام عليكم ورحمة الله استخدم هذا الكود Sub ImportData() Dim ws As Worksheet, Sh As Worksheet Dim i As Integer, x As Integer, day As String Set ws = Sheets("التقرير اليومي") Set Sh = Sheets("بيانات") day = ws.Range("G4").Value ws.Range("E107:L151").ClearContents For i = 19 To 67 Step 12 If Sh.Cells(3, i).Value = day Then x = i + 7 Sh.Activate Sh.Range(Cells(5, i), Cells(49, x)).Copy ws.Activate ws.Range("E107").PasteSpecial xlPasteValues ws.Range("E105") = day End If Next ws.Range("G4").Select Application.CutCopyMode = False End Sub

في الوحدات النمطية لن تعدل شيئا الافي هذا السطر والموجود في الوحدة النمطية الأولى If Connect_SQLDB(nServer_Name, nDB_Login, nDB_Password) Then سوف تستبدل المتغيرات داخل القوسين بما يناسبها : اسم السكوال / اسم المستخدم / كلمة المرور ثم تنتقل الى حدث الزر في النموذج وتستدعي الوحدة النمطية الاولى هكذا : DB_Backup( ...,...,...,...,...,...,...) ستضع مكان النقط ما يناسبها بدلا من المتغيرات التالية ويجب ان يكون بالترتيب الاول فالاول SQL server name اسم السيرفر عندك Database name اسم قاعدة البيانات عندك Login name اسم المستخدم Password كلمة المرور Backup device name اسم الجهاز الذي سيتم النسخ عليه Backup set name اسم النسخة Backup discription وصف النسخة الثلاث الاخيرة حسب اختيارك

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

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

رغم انك لم ترفع ملقاً للتعامل معه لكن عندي انا هذا الملف القديم (مثال عما تريد) أرجو أن يفي بالغرض product &Prices.xlsx

تفضل : جرب ووافني بالنتيجة استخدم هذا الامر تحت زر الأمر : ADD Dim strSQL As String strSQL = "UPDATE [رقم العهد] " & _ "SET [الرقم العام] = myn,[التاريخ] = Date()" DoCmd.SetWarnings False DoCmd.RunSQL strSQL DoCmd.SetWarnings True DoCmd.Requery

ماشاء الله نشاط ممتاز

مشكور يااخى الفاضل

بالتوفيق أستاذي 👍

بارك الله فيكم جميعا على هذا العمل الرائع

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

ابداع-جعله الله فى ميزان حسناتك

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

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

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

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

تفضل هذا برنامج العطاء للعقارات برنامج العطاء للعقارات.mdb

في موضوع لاخي الكريم // مؤمن جمعة (عمل لوحه UserForm بترحيل بيانات) علي الرابط التالي http://www.officena.net/ib/index.php?showtopic=49583&hl= وطلبه لتصميم برنامج لمتابعة حركة السيارات وتسجيل العمليات المتعلقة ونظرا لان عنوان الموضوع لا يدل علي محتواه وبعد اذن ادارة المنتدي طرحت الموضوع بشكل منفصل حتي يكون في متناول الجميع ولسهولة البحث بعد ذلك بالمنتدي الكريم ويمكن تعديل القاعدة لتتلائم مع شركات تاجير السيارات واضافة حساب كيلومترات السيارة وتكلفة الايجار علي حسب الحاجة وادعوا الله ان يكون الموضوع فيه الفائدة للسائل او الباحث شرح موجز لوظائف الفورم ولا تنسونا بدعوة بظاهر الغيب بصلاح الحال متابعة السيارات.rar

تم ارسال البرنامج وكلمة السر والباسورد على الاميل الخاص بك ولك تحياتى

الف شكر لك استاذ علي جعلها الله في ميزان حسناتك

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

كود رائع ودائمًا مبدع زادك الله علمًا

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

THIS CODE Private Sub Worksheet_SelectionChange(ByVal Target As Range) With Me.Range("a1") .Offset(1).Resize(1000, 1) = vbNullString .Value = Selection.Address .Offset(1).Resize(Selection.Rows.Count, 1).Value = Selection.Value End With End Sub

غريب كنت اعتقد اني عدلت على المثال ولكن يبدوا انه يوجد خلل في المثال السابق انظر الآن .. App_open3.rar

تفضل الملف بعد التعديل ..... photo.mdb

الف شكر علي مرورك الطيب استاذي الفاضل انا بستخدم اوفيس 2007

جزاك الله خير ملف مفيد جداً

بارك الله كل فيك وجزاك الله كل خير استاذ سليم

السلام عليكم ورحمة الله وبركاته أحبابى وأصدقائى : أعضاء منتدانا العريق أقدم لكم أحدث الإصدارات لشيت كنترول المرحلة الإعدادية لعام 2018 حسب تعديلات القرار 377 كنترول الإعدادى رجب جاويش الإصدار رقم 18 للترمين والدور الثانى 2018 يشمل كل الأعمال الخاصة بالترم الأول والترم الثانى والدور الثانى ويمكن اختيار الانجليزى مستوى رفيع للمدارس التجريبية تحية لمنتدانا الغالى ولأعضائه الكرام برجاء تجربة البرنامج فى الأيام المقبلة وكتابة أى ملاحظات لكى يتم تعديلها باذن الله ان كانت بالامكان وعذرا لأى خطأ أوسهو أخوكم رجب جاويش كنترول_الإعدادى__رجب_جاويش_الإصدار__18.rar

السلام عليكم ورحمة الله هذه محاولة في الملف المرفق، حيث قمت بحذف المجموعات وجدول المباريات السابق وتعويضهما بجدول واحد من عمودين (سميته جدول المباريات) وهو يتلقى مباشرة نتائج القرعة حتى تتشكل عندنا مباريات الدورة (مباراة واحدة لكل فريق)... وهو يصلح لأي عدد زوجي للفرق (4 - 6 - 8 - 10 - ... فرق) يكفي حجز هذا العدد في الخلية B1، وعدد المباريات تحدده تلقائيا معادلة الخلية B2 (وهو يساوي نصف عدد الفرق) وذلك باعتبار خروج الفريق المغلوب... أخوكم بن علية اجي عملية قرعة لفرق مع خروج المغلوب.rar

السلام عليكم ورحمة الله وبركاته ليه يتم استخدام برامج خارجية لما ممكن نعمل نفس الشيء باستخدام الاكواد انا بستخدم الكود التالي DoCmd.OutputTo acOutputReport, "Q", acFormatPDF, , True, , , acExportQualityPrint

الاخ الكريم محمد نصيحة : لاتستخدم الترقيم التلقائي كأساسي في برامجك ، المبرمجون يضعونه في الجداول كمفتاح (ID) غير ظاهر وتقبل مني هذه الهدية : مثال للترقيم الآلي واعادة الترقيم وطبعا من صنع غيري ولكني انقله كما أخذته