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

مبروك الأستاذ lionheart إنضمامك لعائلة الخبراء ,أسأل الله لك التوفيق والنجاح دائما ..وأعانك الله على هذه المسئولية الجديدة وسدد الله خطاك عن حق وجدارة بارك الله فيك وزادك الله من فضله

يمكنك إضافة العمود c في الترتيب المطلوب هنا تم اعتباره المستوى الثالث للترتيب Sub a_b() Application.GoTo Reference:="sheet" Selection.Sort Key1:=Range("E7"), Order1:=xlAscending, Key2:=Range("F7") _ , Order2:=xlAscending, Key3:=Range("c7"), Order3:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _ False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _ :=xlSortNormal, DataOption3:=xlSortNormal Range("A1").Select End Sub لاحظ إضافة key و order و dataoption لكل مستوى فرز بالتوفيق

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

يمكنك استعمال هذا الاجراء Sub tr7eel() For r = 4 To Cells(Rows.Count, 2).End(3).Row r2 = Evaluate("=MATCH(B" & r & ",'الدور الثانى'!B:B,0)") c2 = Evaluate("=MATCH(C" & r & ",'الدور الثانى'!3:3,0)") Sheet2.Cells(r2, c2) = Range("d" & r) Next r MsgBox "Done by mr-mas.com" End Sub بالتوفيق

Sub Test() Dim a, ws As Worksheet, sh As Worksheet, dic As Object, s As String, t As String, i As Long, c As Long Set ws = ThisWorkbook.Worksheets(1): Set sh = ThisWorkbook.Worksheets(2) Set dic = CreateObject("Scripting.Dictionary") a = ws.Range("A3").CurrentRegion.Value For i = LBound(a) + 1 To UBound(a) s = a(i, 2) & Chr(2) & a(i, 3) If Not dic.Exists(a(i, 1)) Then dic.Add s, a(i, 4) Next i For i = 2 To sh.Cells(Rows.Count, "B").End(xlUp).Row For c = 3 To 8 t = sh.Cells(i, 2).Value & Chr(2) & sh.Cells(3, c).Value If dic.Exists(t) Then sh.Cells(i, c).Value = dic(t) Next c Next i End Sub

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

بل VB افضل من حيث الحماية واخفاء ما تريد حمايتة وخاصة في مثالك تريد عدم التعديل الا برقم سري ..... لان الماكروا حتى بعد حماية القاعدة وتحويلها mde يمكن الاطلاع عليها وتعديلها

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

Congratulations, he deserves it for sure.

@hassansaat تعلم الاستيراد بكل سهولة في البداية قم بإستدعاء مكتبة الإكسل الآن نقوم بإنشاء Module جديد و اضافة الكود التالي Public filenname As String Public Function importExcel(tablename As String) As String ', filenname As String Dim xlApp As Excel.Application Dim xlWb As Excel.Workbook Dim xlWs As Excel.Worksheet Dim intLine As Long Dim strSqlDml As String Dim strColumn1 As String, strColumn2 As String, strColumn3 As String varfile = filenname CurrentDb.Execute "DELETE * FROM List", dbFailOnError Set xlApp = New Excel.Application xlApp.Visible = False Set xlWb = xlApp.Workbooks.Open(varfile) Set xlWs = xlWb.Worksheets(1) intLine = 2 Do strColumn1 = Trim(xlWs.Cells(intLine, 1).Value) strColumn2 = Trim(xlWs.Cells(intLine, 2).Value) strColumn3 = Trim(xlWs.Cells(intLine, 3).Value) strSqlDml = "INSERT INTO List VALUES('" & strColumn1 & "', '" & strColumn2 & "', '" & strColumn3 & "')" CurrentDb.Execute strSqlDml, dbFailOnError xlWs.Cells(intLine, 1).Select intLine = intLine + 1 Loop Until IsEmpty(xlWs.Cells(intLine, 1)) xlWb.Close False xlApp.Quit Set xlApp = Nothing Set xlWb = Nothing Set xlWs = Nothing filenname = "" End Function Public Sub SelectFiles() Dim Addfile As Object Set Addfile = Application.FileDialog(3) With Addfile .AllowMultiSelect = False .InitialFileName = "" .Filters.Clear .Filters.Add "Excel Files", "*.xls,*.xlsx" If .Show = True Then filenname = Trim(.SelectedItems(1)) Else Exit Sub End If End With End Sub شرح مختصر للكود نقوم بالإعلان عن متغييرات تحمل اسماء مستعارة للأعمدة في ملف الإكسل مثلا strColumn1 -strColumn2 - strColumn3 Dim strColumn1 As String, strColumn2 As String, strColumn3 As String الأن نقوم بتعريف المتغييرات على الأعمدة في ملف الأكسل من خلال التعريف xlWs.Cells(intLine, 1).Value حيث أن رقم 1 هو العمود رقم 1 في الاكسل و هكذا strColumn1 = Trim(xlWs.Cells(intLine, 1).Value) strColumn2 = Trim(xlWs.Cells(intLine, 2).Value) strColumn3 = Trim(xlWs.Cells(intLine, 3).Value) تفضل التعديل Access-Import.accdb

بعد اذن استاذنا @kanory تفضل New Microsoft Access Database.rar

هذا ملفك بعد التطبيق New Microsoft Excel Worksheet.xlsb

شكرا جزيلا يا استاذ محمد انا بتعبك معايا كتير

السبب في ذلك هو طريقة إدخال البيانات حيث تم التعامل مع التاريخ على أنه نص وليس تاريخا والحل استعمال المعادلة التالية في الخلية G3 =VALUE(F3) مع سحب المعادلة لأسفل ثم نسخ بيانات هذا العمود الجديد ولصقها في عمود التاريخ كقيم مع تنسيق عمود التاريخ كتاريخ بعدها يمكن حذف العمود F بالتوفيق

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

وعليكم السلام ورحمة الله وبركاته اضعط زر Shift + زر 6 بالاعلى ^ تحياتي 10^9

تفضل اخي الكريم هذه طريقة افضل واسرع ضع الكود التالي في وحدة نمطية جديدة Public Function XNul(txt1 As Double, txt3 As Double) As Double If Nz(txt1, 0) > 0 And Nz(txt3, 0) > 0 Then XNul = (txt1 / txt3) * 100 Else XNul = 0 End If End Function ثم في الاستعلام ضع التالي مع تغيير اسماء الحقول Expr1: XNul(Nz([المدفوعات]);Nz([صافى الفواتير])) تحياتي

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

هكذا يفعل غير المسلمين donate coffee لكن بعض المسلمين ..... لا يعرفون أن العطاء سعادة وهذا الشعور هو الذي يدفع من يساعد الآخرين إلى عمل ما يقوم به تطوعا وفقنا الله جميعا لكل ما يحبه ويرضاه

محاسب مبتدأ كلفت بعمل جرد يومي للفروع واريد ان اقوم بالجرد عن طريق شيت الاكسل المرفق ارجو الاطلاع جرد فوع.rar

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

تفضل جمع مدد الخدمة بالنموذج2.rar

مبارك - نساله تعالى لكم التوفيق والتقدم ما شاء الله، أسأل الله أن يبارك لك وينفع بك أمة محمد صلى الله عليه وسلم

وعليكم السلام ورحمة الله وبركاته تفضل هذه تجرية iif(nz([المدفوعات])>0;(nz(المدفوعات)/nz(صافى الفواتير))*100;0) تحياتي

تفضل اخي الكريم Private Sub NO_AfterUpdate() DoCmd.SetWarnings False DoCmd.OpenQuery "Query1" DoCmd.SetWarnings True End Sub Private Sub NO_Exit(Cancel As Integer) Me.Requery End Sub Private Sub رقم_الموظف_GotFocus() DoCmd.GoToControl "NO" End Sub بيانات الموظفين.accdb تحياتي

الشكر لله الذي وفقنا جميعا للخير

ماشاء الله اسال الله ان يبارك لك

يمكنك استعمال هذا الكود في حدث عند التغيير في شيت سعد ولمن لا يعرف كيفية إضافة الكود في أحداث الصفحة كلك يمين على اسم الشيت ونختار view code بالعربي عرض التعليمات البرمجية ثم نلصق الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$F$5" Then Sheet24.Range("b10:i1000").ClearContents For r = 3 To Sheet14.Cells(Rows.Count, 2).End(3).Row If Sheet14.Range("n" & r) = Target Then lr = Sheet24.Cells(Rows.Count, 2).End(3).Row + 1 cols = Array(3, 2, 9, 10, 11, 5, 14, 15) For n = 2 To 9 Sheet24.Cells(lr, n) = Sheet14.Cells(r, cols(n - 2)) Next n: End If: Next r MsgBox "Done by mr-mas.com" End If End Sub بالتوفيق

تستحقها عن جدارة الف مبارك وفقك الله

الف مبروك و الي الامام دائما باذن الله 🌼

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

تفضل التعديل ارجو ان يكون طلبك استعلام-1.rar

مجهود واضح واعمالك متقنة وان شاء الله من نجاح الى نجاح

ما شاء الله، أسأل الله أن يبارك لك وينفع بك أمة محمد صلى الله عليه وسلم.

الف مبروك على الترقية الى درجة خبير

Thank you very much for this trust. I am not expert, I am just a learner

مع كل الأسف الفيديو غير متوفر

مشاركة مع استاذ Eng.Qassim تفضل التعديل ارجو ان يكون طلبك INVOICES-2.rar

اسف جدا على التاخير لوجود عطل في حاسبتي ..تقوم بعمل استعلام لتحديث الحقل REF_INVOICE..يمكنك الاستفادة من المثال المرفق INVOICE.mdb

بعد اذن الأستاذ أحمد طبعاً .... من خلال هذا الفيديو كيفية إضافة أكواد الـ VBA في ملف الإكسل Excel Training

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

لدي bitdefender2010 كمضاد للفيروسات وie8 و firefox 3.6 beta كمتصفح ولا يوجد أدنى مشكلة ولا أي رسالة وأعتقد أنه يوجد بعض مضادات الفيروسات تعتبر أكواد الجافا سكريبت فيروسات كما تعتبر بعض البرامج أكواد vba فيروسات ولذا يجب تمكين الاسكربتات من خيارات المتصفح enable scripts والله الموفق نداء لجميع الأعضاء للمشاركة في موضوع مشاركة المفضلة الشخصية الموجود بتوقيعي

بسم الله الرحمن الرحيم أولا بارك الله فيك أخي الكريم على هذه الهدية القيمة ثانيا اطلب من الإخوة المشرفين نقل الموضوع إلى القسم المفتوح مثلا حيث لا علاقة له بالإكسل ثالثا لمن أراد أن يستمع للقرآن بصوت 86 قارئ قابلة للزيادة مع مشاهدة المصحف الفلاشي الرائع المتعدد المصاحف حيث يوجد به المصحف المفسر والمصحف المترجم والمصحف بطبعة المدينة وطبعة الحرمين وغيرها من المميزات فعليه بزيارة هذا الموقع http://alostaz.freetzi.com/ http://alostaz.coolpage.biz/quran أحد مواقعي الشخصية وأحد تصاميمي بلغة php وفقنا الله وإياكم لكل ما يحب ويرضى

رائع أخي يحيى أحياك الله في طاعته

بارك الله فيك أخي عادل وفقك الله إلى ما فيه رضاه

أخي الكريم يمكنك استعمال هذه المعادلة قي التحقق من الصحة =COUNTIF($A$1:$A$19;$A1)<4 جرب وأخبرني بالنتيجة كان هذا ردي الذي حاولت إرساله سابقا ولكن نظرا لوجود عطل في النت عندي لم يتم إرساله

حتى تعم الفائدة يمكنك إرفاق ملفك بعد وصولك للإجابة خالص تحياتي

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

رائع أخي خبور خير ما أجمل بساطة الأكواد جزاك الله خيرا

أخي الكريم سالم كما أخبر أخونا آدم ممكن يكون نقص في الملفات وأنا شخصيا لا أستعمل تعليمات الأوفيس المضمنة فيه وإنما أستخدم هذا الرابط