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

أما عن مشاركتي.. استخدمت أدوات ActiveX لأنها قابلة للإستنساخ (التوريث).. عند الضغط على زر الفارة الأيسر يقوم الحدث باستنساخ إداة العنوان ووضعها في موقع النقر تتضمن رقماً يمثل رقماً افتراصيا للأرض المعروضة للبيع.. بعد ذلك يقوم الحدث بتسجيل المعطيات في جدول البيانات (رقم الأرض الافتراضي، موقع أداة العنوان،..) الأدوات المستنسخة صورية لاتحفظ داخل النموذج.. ويتم محوها عند إغلاق النموذج! لكن يعاد استنساخ هذه الأدوات عند إعادة فتح النموذج بناءً على المعطيات التي سبق حفظها في الجدول.. Map Pointer.zip

لن يطول انتظارك بإذن الله.. في الواقع قد رتبت لهذا من قبل! ولم يمنعني من رفعه دفعة واحدة إلا التشويق! وأن يرى الزملاء الأشياء الجديدة على مهل.. Map Pointer.zip

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

تفضل يمكنك هذا بهذه المعادلة =IFERROR(INDEX(البيانات!$C$2:$F$11,MATCH($B2,البيانات!$B$2:$B$11,0),MATCH(C$1,البيانات!$C$1:$F$1,0)),"") تقرير1.xlsx

تجد ذلك في نموذج HTML تحت السجل CSS جميع الوسوم المتعلقة بالتزيين مدرجة تحت هذا السجل.. لكن يجب عليك الرجوع إلى W3 School لمعرفة المزيد عن ذلك.. يجب أن يكون مستوى المعرفة لديك بشفرة VBA فوق المتوسط لان بمرمجة صفحات HTML يعتمد كليا على الشفرة البرمجية.. نعم HTML مغري لكن يحتاج إلى قليل من التعب! يمكن عمل مثل هذه النوافذ.. لكن أرفق لي قاعدة بيانات فيها جدول بهذه المعلومات حتى أقوم بتزيينها بهذا الشكل.. إن أردت..

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

ما شاء الله تبارك الله بارك الله فيك استادنا الكبير @أبو إبراهيم الغامدي مدرسة نتعلم منك الكثير ......

يعطيك العافيه اخي @أبو إبراهيم الغامدي طريقة رائعه و استاذ قدير ..... بارك الله فيك وفي وقتك

جزاكم الله خيرا نحتاج الي (مهل..) كثير للفحص والتعلم قد واجهت قديما مشكلات مع اضافة عنصر ActveX لذي عزفت عن استخدامها بالكلية ، نرجو ان اتسع لكم وقت أن تفردو موضوعا لشرح هذه الأداة وبعض خصائصها وجزاكم الله خيرا (أعتقد أن هذه الأداة لها علاقة بأداة الويب بروزر هل هذا صحيح)

أعتذر عن المشاركة بغير استئذان - وانما الشكر لكم استاذي علي ما تقدمونه لنا من علم أما عن أمر الخط فكل ما يحتاجه أخونا @at_aziz هو اجراء تعديل كهذا lbl.Font.Size = 9 <=== غير في الحجم هنا كما تريد lbl.Font.Bold = True <==== أضفت هذا ويمكن الاستغناء عنه ولكن العجيب أن الليبل له خصائص مختلفة تماما عن ليبل الأكسس فله خاصية صورة وخواص أخري كثير ما هذا الليبل؟!!

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

في هذا السطر من الكود يأخذ الليبل لونه بطريقة عشوائية lbl.BackColor = RGB(Int(150 * Rnd), Int(150 * Rnd), Int(150 * Rnd)) غيره الي هذا ليصبح باللون الأحمر مثلا lbl.BackColor = vbRed

نعم واعتقدت أن تثبيت موضع الصورة علي الفورم سيعمل علي توحيد موضع المؤشر ولكن يبدو ان الأمر سار علي خلاف ما أتوقع نعم أخذت نقطتي الـ X & Y من اطار الصورة ولكن يبدو ان المشكلة ان الصورة تتمدد مع تمدد الفورم ولا أدري هل تثبيت موضع الصورة علي الفورم سيحل المشكلة أم لا؟! قم باظهار مربع النص علي الفورم الذي يلتقط موضع المؤشر وفعل الكود في حدث عند تحريك الفأرة للصورة وعدل مواقع النقاط في الجدول وفقا لأرقامها الجديدة عندك ولكن لا أنصحك بفعل كل هذا ففي مرفق أستاذنا @أبو إبراهيم الغامدي الغنية عن كل هذا ان شاء الله فعند تجربة المرفق تبين لي أنه يصلح للادخال وعرض البيانات من خلال النقر علي الصورة في آن واحد (وهذا هو الابداع المنتظر من الاساتذة )

وعليكم السلام ورحمة الله وبركاته.. مشاركة جميلة أ. محمد.. طبعاً الفكرة قائمة على هذا المبدأ : التقاط موقع المشيرة كنقطة في الخريطة.. استخدام GetCursorPos يتعامل مع شاشة الحاسب، وبالتالي النقاط التي حددتها هي للشاشة ليس الصورة! عليك البقاء في إطارة الصورة، واستخدم حدث MouseDoun وخذ مؤشر X، ومؤشر Y كقطة على الخريطة.. لمراقبة تحرك الفارة استخدم حدث MouseMove وخذ مؤشر X، ومؤشر Y كقطة وضعه كقيمة في مربع النص..

تفضل هذا التعديل اخي الكريم Dim My_Selectdata1 As String Dim My_Selectdata2 As String Dim My_SelectdataWhere As String My_Selectdata1 = "INSERT INTO Table_777_MaturityscheduleOte ( Dart, Finncy, [Stop-Salary], CodeStaff, NameStaff, CodeJ, NameJop, CodeSec, NameSection, CodeAdm, NamAdmin, NamCopmany, DateStarWork, NameAsthkak, SalaryPrimry, BadelMove, BadelTravil, BadelOther, PricDay, NoHourse, NoDayStadar, NoDayAchoal, HorsOverTim, ValueOverTim, HorsBack, ValueHorsBack, StopDay, ValueStopDay, GoAfters, ValueQun, GoAprovit, ValueAprovit, SalaryCut, Akopat, ValueAkopat, Kadwoo, ValueKadwoo, TotalS, TotalCut, TotalFree, Descrption, AccountBank, CodeBancks, NamesBancks, AccountBankCombany, Tawgih, Depet, Elpians, PisceLink )" My_Selectdata2 = "SELECT Dart, Finncy, [Stop-Salary], CodeStaff, NameStaff, CodeJ, NameJop, CodeSec, NameSection, CodeAdm, NamAdmin, NamCopmany, DateStarWork, NameAsthkak, SalaryPrimry, BadelMove, BadelTravil, BadelOther, PricDay, NoHourse, NoDayStadar, NoDayAchoal, HorsOverTim, ValueOverTim, HorsBack, ValueHorsBack, StopDay, ValueStopDay, GoAfters, ValueQun, GoAprovit, ValueAprovit, SalaryCut, Akopat, ValueAkopat, Kadwoo, ValueKadwoo, TotalS, TotalCut, TotalFree, Descrption, AccountBank, CodeBancks, NamesBancks, AccountBankCombany, Tawgih, Depet, Elpians, PisceLink FROM Table_776_Maturityschedule" My_SelectdataWhere = " WHERE (((Table_776_Maturityschedule.CodeStaff) Between [Forms]![Frm_776_Monthlyroutinescreen]![TextCodeEmp] And [Forms]![Frm_776_Monthlyroutinescreen]![ToextCodeEmp]));" If Me.TextCodeEmp = "" Or Me.TextCodeEmp = " " Or Me.TextCodeEmp = Null Or Me.TextCodeEmp = 0 Then MsgBox "يجب ادخال كود الموظف للاستمرار", vbCritical + vbMsgBoxRight, "تنبيه" Exit Sub Else If MsgBox("هل تريد ترحيل الملف المحدد الى جدول الاستحقاق ؟" & _ vbNewLine & " كود الموظف" & " من " & " : " & Me.TextCodeEmp & " - " & " الى " & " : " & Me.ToextCodeEmp, vbYesNo + vbMsgBoxRight + vbExclamation) = vbYes Then DoCmd.SetWarnings False DoCmd.RunSQL My_Selectdata1 & My_Selectdata2 & My_SelectdataWhere DoCmd.RunSQL "DELETE FROM Table_776_Maturityschedule" & My_SelectdataWhere DoCmd.SetWarnings True MsgBox "تم عمل الروتين الشهري وتم اغلاق الروتين", vbInformation + vbMsgBoxRight, "نقل بيانات الرواتب" DoCmd.Close End If End If الترحيل.rar

تفضل 🙂 واذا ما تريد ان ترى مجاميع كل سجل او عمود Sum_Stores ، فلا تحذفه ، وانما اجعله مخفي ، واجعل عرضه =0 ويمكنك تطبيق نفس الطريقة على التقرير (ان وُجد) 🙂 🙂 جعفر 1311.11.DATA12.mdb.zip

2. اعمل نسخة من برنامجك ، ثم اعمل لها "ضغط واصلاح" من داخل الاكسس ، ثم استخدم احد برامج الضغط مثل winrar او winzip او 7z ، ثم ارفق الملف المضغوط 🙂 1 و 3. اذا تم حل المشكلة ، فماهو المطلوب اذن !! انا حليت لك طلبك وارفقت لك الملف اللي فيه الحل ، فماهو المطلوب الآن ؟ اخوي احمد ، انا الذي اخترت افضل اجابة ، لأن اجابتي هي مجرد توسع في اجابتك 🙂 جعفر

جرب هذا الملف Islam.xlsx

السلام عليكم ورحمة الله وبركاته أشارك مع اساتذتي بهذه المحاولة البسيطة لحين تكرم احدهم بالحل الشافي هي غير احترافية بالمعني ولكن أثق بقدرتك علي تطويرها لتصل بها الي شكل أفضل ان شاء الله افتح المرفق واضغط علي النقاط الحمراء بالصورة وانظر النتيجة واضغط علي الخضراء ان اردت ولكن لن يحدث شئ! طبعا حاولت اجعل فورم الوصف يتحرك تحت المؤشر ولكن لم استطع الوصول لعل احد اساتذتنا الكرام يتفضل بالتعديل هذا المرفق وهذا تصوير من جهازي ملاحظة: اجعل الصورة بجور البرنامج بنفس المسار MoveOnMaps.rar

جرب هذا الكود Option Explicit Sub All_in_One() Dim Ob As Object Dim Lr, i Dim Sd#, Se#, Sf#, Sg#, _ Sh#, Si#, Sj#, Sk# Dim kY Dim Sal As Worksheet Set Sal = Sheets("Salim") Lr = Sal.Cells(Rows.Count, 1).End(3).Row Sal.Range("P2").Resize(Lr, 12).ClearContents Set Ob = CreateObject("Scripting.Dictionary") With Sal For i = 2 To Lr Sd = Sd + Val(.Cells(i, "D")): Se = Se + Val(.Cells(i, "E")) Sf = Sf + Val(.Cells(i, "F")): Sg = Sg + Val(.Cells(i, "G")) Sh = Sh + Val(.Cells(i, "H")): Si = Si + Val(.Cells(i, "I")) Sj = Sj + Val(.Cells(i, "J")): Sk = Sk + Val(.Cells(i, "K")) Ob(.Cells(i, 1) & "*" & .Cells(i, 2) & "*" & .Cells(i, 3)) = _ Sd & "*" & Se & "*" & Sf & "*" & Sg & "*" _ & Sh & "*" & Si & "*" & Sj & "*" & Sk If .Cells(i, 1) <> .Cells(i + 1, 1) Then Sd = 0: Se = 0: Sf = 0: Sg = 0: _ Sh = 0: Si = 0: Sj = 0: Sk = 0 End If Next For i = 0 To Ob.Count - 1 .Cells(2, "p").Offset(i).Resize(, 3) = Split(Ob.KEYS()(i), "*") .Cells(2, "S").Offset(i).Resize(, 8) = Split(Ob.iTEMS()(i), "*") Next .Cells(1, "P").CurrentRegion.Value = _ .Cells(1, "P").CurrentRegion.Value End With End Sub الملف مرفق صفحة Salim Ali_Mas.xlsm

السلام عليكم ورحمه الله وبركاته هدية لأعضاء المنتدى الكرام برنامج أرشفة الخطابات و الوثائق .. الأرشفة الالكترونية مفتوح للعمل عليه غير محدد المدة ومش تجريبي مغلق المصدر (الاكواد) وتعديل النماذج تحياتي user 1234 1118021174_Archivesopen18-1-2021.rar

كان في تقديري عند تلوين المؤشر أن استخدم ذلك في تلوين المؤشر حسب نطاق سعر البيع! لكن..

جزاك الله خير أخي @أبو إبراهيم الغامدي بارك الله فيك ....

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

أهلا بك أ. سلمان.. في الحقيقة ليس هناك شفرة لأكسس متعلقة بهذا الموضوع! إنما هي وسوم CSS الخاصة بتزيين صفحات الويب.. يمكن أن تبحث في W3 School تحت CSS3 عن الوسمين Transition و Transform

بارك الله فيكم وجزاكم الله خير الله يعطيكم العافيه ماقصرتو شاكر ومقدر لكم ونحن بانتظارك ابا ابراهيم

نعم.. يمكن إن شاء الله.. حتى أنهي ذلك أطلب من أ. @أبو عبدالله الحلوانى أن يهتم بموضوع الخط..

ThisWorkbook.Sheets("sheet3").ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "oo", OpenAfterPublish:=True

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

جرب هذا الملف Moust.xlsx

لا افهم ما الحاجة الى الحلقات التكرارية في هذه الحالة يكفي هذا الكود بعد تنفيذ الكود يتم استبدال المعادلات بقيمها الحقيقية من خلال الأمر (value=.value.) للتقليل من حجم الملف لانه يحنوي على 10 أعمدة (حيث يوجد معادلات) في كل واحد حوالي 10000 معادلة ( و بذلك لا يتم ارهاق البرنامج بحساب أكثر من 100 الف معادلة مع كل ضربة على الكيبورد او نقرة من الماوس) Sub Get_by_formula() Dim Last_ro%, New_row With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With With Sheets("Sheet3") Last_ro = .Cells(Rows.Count, 1).End(3).Row .Range("O2").Resize(Last_ro - 1, 13).Clear .Range("P2").Resize(Last_ro - 1, 3).Value = _ .Range("A2").Resize(Last_ro - 1, 3).Value .Range("P2").Resize(Last_ro - 1, 3).RemoveDuplicates _ Columns:=Array(1, 2, 3) New_row = .Cells(Rows.Count, "P").End(3).Row With .Range("O2").Resize(New_row - 1, 13) .Borders.LineStyle = 1 .Font.Bold = True .Font.Size = 12 .InsertIndent 1 .Cells(1, 5).Resize(New_row - 1, 8).Formula = _ "=SUMPRODUCT(--($P2&$Q2&$R2=$A$2:$A$10000&$B$2:$B$10000&$C$2:$C$10000),D$2:D$10000)" .Cells(1, 1).Resize(New_row - 1).Formula = _ "=SUMPRODUCT(--($P2&$Q2&$R2=$A$2:$A$10000&$B$2:$B$10000&$C$2:$C$10000))" .Cells(1, 13).Resize(New_row - 1).Formula = _ "=ROUND(AVERAGE(S2:Z2),2)" .Value = .Value End With End With With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub الصفحة Sheet3 من هذا الملف Ali_1xlsm.xlsm

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

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

Private Sub Worksheet_Change(ByVal Target As Range) ' ' On Error Resume Next If Not Intersect(Target, Range("a2:a10000")) Is Nothing Then Target.Offset(, 1) = Format(Date, "dd-mm-yyyy") End If End Sub ضع الكود في حدث الشيت ادخال البيانات في العمود 1 ويظهر التاريخ في العمود2

تفضل من خلال الأداة التالية يمكنك التحويل في الإتجاهين Sql2vba.zip

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

للمعلومة الباترن الذي وضعته لك، يجعل التكست يقبل فقط الحروف العربية والانجليزية فقط! ويمنع كتابة الأرقام والرموز حسب طلبك.

معلش انا مش فاهم برجاء التوضيح وياريت بالمثال وإدراج اكتر من صف وقيم بالاعمده والنتيجه المرجوه بالنسبه افتح النموذج في عرض التصميم أقف ع مربع النص الذي تريده فالخصائص هتلاقي تنسيق استخدم تنسيق ثابت اوقياسي ملاحظه برجاء تعديل أفضل اجابه لأخي ومعلمي العزيز جعفر لأنها افضل َاروع اجابه جزاه الله عنا كل خير بالتوفيق ابو إحسان

جرب هذا الملف Takrir.xlsx

طلبك اعتقد انه في حال تساوي XXX ب t1 أو t2 وليس و ثم ان وقت الدخول المفروض اقل من وقت انتهاء الدرس اليس كذلك ؟؟؟

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

مثال من موقع أجنبي ربما يشكل بداية للفكرة GetPhotoLocation v1.2.zip

السلام عليكم وذلك من خلال هذه المعادلة بداية من الخلية P2 =IFERROR(INDEX($A$2:$A$550,AGGREGATE(15,6,ROW($A$1:$A$302)/(MATCH($A$2:$A$550&$B$2:$B$550&$C$2:$C$550,$A$2:$A$550&$B$2:$B$550&$C$2:$C$550,0)=ROW($A$1:$A$302)),ROWS($2:2))),"") Book2.xlsx

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

وعليكم السلام 🙂 اعطني بعض الوقت حتى ابلور الفكرة 🙂 جعفر

وعليكم السلام-تفضل لك ما طلبت ـ تــم ترجمة ملفك الأرباح والخسائر.xls

أهلابك.. نعم يمكن.. انسخ السطر المتعلق بالزر والذي أشرت إليه أعلا وسوف يأخذ نفس الخصائص Dashboard2003.mdb

أهلا بك عزيزي أحمد.. في الواقع لم أفعل .. أما عن الاشكالات.. فمن أهمها.. استشعار أحداث وسوم صفحة المستعرص من داخل أكسس! وهذا بحمد الله تم الانتهاء منه.. جعل الصفحة تتفاعل مع تنسيقات الجيل الجديد.. وهذا بحمد الله تم الانتهاء منه.. أما العقبات.. فمن أقواها.. الكسل.. الوقت.. انظر إلى الفرق بين النسخة السابقة من المثال وبين النسخة التالية Dashboard2003.mdb

أهلا بك عزيزي.. لا بأس إذا كان الأمر يتعلق بذات الموضوع.. زر الأمر "المزيد" عبارة عن رابط.. والروابط في HTML تحدث انتقال إلى شيء ما.. في حدث "قبل الانتقال" المتعلق بالروابط الموجودة على الصفحة: نقوم بإعاقة الرابط من الانتقال، وبعدها نأخذ بيانات الغرفة -والتي سبق أن مررناها للرابط- ونضعها في وظيفة فتح النموذج.. هذا كل ما في الأمر.. <a href='" & "ID" & RS(0) & "' class='button'> المزيد </a> خصيصة الرابط "href" مررنا إليها معرف الشقة، وعند النقر عليها يمرر المستعرض هذه القيمة إلى محدد نصي اسمه "URL" في حدث ما قبل الانتقال "BeforeNavigate2".. بعد ذلك نعيد استخراج معرف الشقة ونمرره إلى وظيفة فتح النموذج Private Sub WebBrowser_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean) If URL Like "about:id*" Then 'Debug.Print URL DoCmd.OpenForm "FM_2", , , "cstr(ID)=" & CStr(Mid(URL, 9)), , acDialog Cancel = True End If End Sub

قصدك اول سجل ، بينما لما تنقر على اي حقل في السجل الثاني ، ستجد انه يعطيك مجموع ذلك السجل ، وهكذا ، .... لماذا ؟ ، لأنك لم تطلب ان يتم جمع جميع السجلات !! الطريقة الصحيحة لعمل مطلبك : 1. مربع المجموع ، بدل ان يكون في الاعلى ، يجب ان تضعه بين حقول السجل (انت تختار المكان) ، هكذا : . 2. مصدر بيانات هذا النموذج هو الاستعلام qry_Items_Dates_2 : . فيجب ان تعمل حقل جديد في الاستعلام ، ويكون فيه معادلة اخوي احمد ، بمعنى : مجموع مخازن كل سجل على حدة ، 3. وبعد ان تكون قد وضعت الحقل اعلاه (رقم 1) بين السجلات ، يجب ان تعمل حقل آخر في سطر "اجمالي" ، وتجعله يجمع قيم السجلات جميعا : . جعفر