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

السلام عليكم ورحمة الله وبركاته اليكم برنامج الجرد خاص بالمصالح الاقتصادية دمتم في رعاية الله وحفظه. برنامج الجرد العام 2022 (2).rar

AutoFilter with 34 Dynamic Filter Criteria اتوفلتر ب 34 دينامك شرط كما لم تراه من قبل !!!_XlDynamicFilterCriteria.xlsb

Sub Test() Const iNum As Double = 50 Dim a, t As Double, i As Long, k As Long Application.ScreenUpdating = False With ActiveSheet a = .Range("A4:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Value ReDim b(1 To UBound(a, 1) * 10, 1 To 1) For i = LBound(a) To UBound(a) k = k + 1 If a(i, 1) <= iNum Then b(k, 1) = a(i, 1) ElseIf a(i, 1) > iNum Then t = a(i, 1) Do b(k, 1) = IIf(t >= iNum, iNum, t) t = t - iNum k = k + 1 If t <= iNum Then b(k, 1) = t: Exit Do Loop Until t < iNum End If Next i .Range("E10").Resize(k, UBound(b, 2)).Value = b End With Application.ScreenUpdating = True End Sub

لاحظ النموذج المرفق واشتغل عليه ربما لايشبه ماتفضلت به ...لكنه يعطي فكرة g1.accdb

وعليكم السلام 🙂 اهلا وسهلا بك في المنتدى ، وللاستفادة القصوى من المنتدى ، رجاء قراءة قوانين المنتدى: اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة الطلب في غاية البساطة ، والمنتدى مليء بمثل هذا السؤال ، فاستعمل البحث للحصول على هذه المواضيع ، واليك احد الروابط وبه طلبك جعفر

اذا قصدك تدخل البيانات مباشرة في اول حقل من اول سجل مباشرة . فيصبح الكود: Private Sub Numberx_AfterUpdate() ' 'Access looks at it this way: 'user 1 = first entry was done in the Form by hand 'user 2 = the code below enters values automatically ' 'so it will give the popup option to either: save these change, drop the saving, or place them in clipboard 'to avaoid this message, we should first save the hand made value, then run the code 'save the Records If Me.Dirty Then Me.Dirty = False Dim rst As DAO.Recordset Dim i As Long Set rst = Me.RecordsetClone rst.MoveFirst i = Me.Numberx Do Until rst.EOF i = i + 1 rst.Edit rst!Numberx = i ' rst!serial = Me.str_serial rst.Update rst.MoveNext Loop 'MsgBox "Done" End Sub Private Sub serial_AfterUpdate() Dim rst As DAO.Recordset Dim i As Long Dim str As String str = Me.serial 'save the Records If Me.Dirty Then Me.Dirty = False Set rst = Me.RecordsetClone rst.MoveFirst Do Until rst.EOF rst.Edit ' rst!Numberx = Me.int_Numberx + i rst!serial = str rst.Update rst.MoveNext Loop 'MsgBox "Done" End Sub جعفر 1505.1.make serial numbers.mdb.zip

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

وعليكم السلام 🙂 اضفت حقلين للنموذج ، int_numberx ، و str_serial ، و زر لتنفيذ العمل ، . وهذا الكود على حدث نقر الزر: Private Sub cmd_Do_Changes_Click() If Len(Me.int_Numberx & "") = 0 Then MsgBox "رجاء تعبئة اول رقم لبداية التسلسل" Me.int_Numberx.SetFocus Exit Sub ElseIf Len(Me.str_serial & "") = 0 Then MsgBox "رجاء تعبئة خانة كلمة الحقل" & vbCrLf & "serial" Me.str_serial.SetFocus Exit Sub End If Dim rst As DAO.Recordset Dim i As Long Set rst = Me.RecordsetClone rst.MoveFirst Do Until rst.EOF i = i + 1 rst.Edit rst!Numberx = Me.int_Numberx + i rst!serial = Me.str_serial rst.Update rst.MoveNext Loop MsgBox "Done" End Sub جعفر 1505.make serial numbers.mdb.zip

بعد اذن الاخوة هذا الشيء ينسخ المدى المحدد ويحوله الى pdf حدد المدى الذي تريد وفعل الماكرو Option Explicit Sub rngSelect() Dim R Dim fil_name fil_name = ThisWorkbook.Path & "\" & fil_name & Format(Now(), "dd-mm-yyyy- hh.mm.ss") R = (Selection.Address) Range(R).ExportAsFixedFormat Type:=xlTypePDF, Filename:=fil_name MsgBox "النسخة تجدها في نفس مكان الملف الاصلي", vbInformation End Sub

برنامج حساب أرباب العهد بالمصالح الحكومية محدث 2022 تم تعديل البرنامج طبقا لقرار وزير المالية 610 لسنة 2021 والكتاب الدورى رقم 171 لسنة 2021 بقوم البرنامج بحساب القيمة الخاصة بأرب العهد بالمصالح الحكومية لعدد 14 موظفا بالمصلحة وكل ما عليلك سوى ادخال البيانات التالية : 1- إسم الموظف 2- الوظيفة 3- عدد شهور مدة التأمين والافتراضى انها 12 شهر سنة مالية كاملة 4- تحديد نوع الاجر سواء كان ( اجر وظيفى - اجر أساسى) 5- القيمة التقديرية لرب العهدة 6- بالضغط على زر الطباعة لطباعة نموذج ارباب العهد الملف مرفق https://docs.google.com/spreadsheets/d/1kxGqlK8rAoK6c427RZpQmsX052qJLGZx2q57z1p17WY/edit?usp=sharing حساب أرباب العهد عام 2022.xlsm

وعليكم السلام .. بعد اذن استاذي ابو موسى كأنك تصدر الجدول كما هو !! اذن فما فائدة الاستعلام لنفرض لديك معرض سيارات .. ولديك جدول السيارات وجدول الزبائن وتريد معرفة السيارات التي لم تشترى من قبل اي من الزبائن.. فيمكن استخدام الاستعلام SELECT * FROM cars WHERE CarID NOT IN( SELECT CarID FROM customers); وبعدها يتم التصدير لاكسل كما تحب المهم .. ان نفهم ما الذي نريد استخراجه من الاستعلام تحياتي لك

تم عمل موضوع جديد للحوار حول نسخ/اصدارات الاكسس ، لأنه خارج عن موضوع هذا السؤال 🙂 جعفر

يوجد بالملف المرفق طريقتين للبحث عن الايام المفقودة ..ارجو ان يناسبك واحد منها ..تفضل اخي att test#2.xlsb

تمام هذا هو المطلوب بالظبط

وعليكم السلام بصراحة لم افهم الغاية من الطلب لانه عادة مايكون هناك ربط بين الرئيسي والفرعي حتى تكون سجلات الفرعي تابعة لمفتاح فريد لكن حسب طلبك ..انظر للمرفق REPORT.accdb

شاهد المرفق اخي فورم الترحيل لأكثر من ورقة عمل .xlsm

تفضل 🙂 الآن الكود يبدأ بالرقم الذي تكتبه في اول حقل : Private Sub Numberx_AfterUpdate() ' 'Access looks at it this way: 'user 1 = first entry was done in the Form by hand 'user 2 = the code below enters values automatically ' 'so it will give the popup option to either: save these change, drop the saving, or place them in clipboard 'to avaoid this message, we should first save the hand made value, then run the code 'save the Records If Me.Dirty Then Me.Dirty = False Dim rst As DAO.Recordset Dim i As Long Set rst = Me.RecordsetClone rst.MoveFirst i = Me.Numberx - 1 Do Until rst.EOF i = i + 1 rst.Edit rst!Numberx = i ' rst!serial = Me.str_serial rst.Update rst.MoveNext Loop 'MsgBox "Done" End Sub . او Private Sub Numberx_AfterUpdate() ' 'Access looks at it this way: 'user 1 = first entry was done in the Form by hand 'user 2 = the code below enters values automatically ' 'so it will give the popup option to either: save these change, drop the saving, or place them in clipboard 'to avaoid this message, we should first save the hand made value, then run the code 'save the Records If Me.Dirty Then Me.Dirty = False Dim rst As DAO.Recordset Dim i As Long Set rst = Me.RecordsetClone rst.MoveFirst i = Me.Numberx Do Until rst.EOF rst.Edit rst!Numberx = i ' rst!serial = Me.str_serial rst.Update i = i + 1 rst.MoveNext Loop 'MsgBox "Done" End Sub جعفر

جزاء الله كل خير تمت ان شاء الله بفضل مجهوداتكم ...شكرا جزيلا لك

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

كيف عند فلق الملف يحفظ ك مريم 17-مايو-2022

يمكنك استخدام هذا الكود فى حدث Thisworkbook Private Sub Workbook_Open() Worksheets("æÑÞÉ1").Activate Range("c2").Select End Sub ورقة عمل1 Microsoft Excel جديد.xlsm

شاهدي المرفق Tq.xlsm

تفضل ...اتمني ان تكن انتهت المهمة الملف خلطة العملاء.xlsm

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

تفضل يا سيدي 🙂 جعفر 1506.Export catiopns to excel.mdb.zip طيّرت المزّة 🤣

1)هذا الكود الذي وضعته سينقلك للشيت الهدف2)جرب وضع هذا الكود بهذه الطريقة في حدث الورقة بعد الدخول عليها Private Sub Worksheet_Change(ByVal Target As Range) Range("c2").Select End sub

الكود موجود ما يحتاج بخور سيدي جعفر .... ماكروا مرتبط بفانك .... 😄

نعم كلامك صحيح ، اذا اردنا ان نرى جميع الجداول ، ولا نرى جداول النظام ، ولكن ، طريقتي في تسمية الجداول هي: للجداول المرتبطة بالشبكة: tbl_abc للجداول المحلية: loc_tbl_abc للجداول المؤقته: tmp_tbl_abc و نادرا ان اسمي احد الجداول باسم جدول النظام مثل Msys_abc (في الواقع اني ابداً لم اعمل هذا النوع من الجداول) ، فلا اريد ان يكون هناك مستخدم شاطر يعرف يبحث في الانترنت ويعرف كيف يظهر هذه الجداول ، ويحرق الاخضر واليابس !! فالكود كان معمول حتى يستخرج تسميات/اسماء حقول الجداول التي تبدأ بـ _tbl ، ولم اغير فيه🙂 جعفر

الف شكر لحضرتك الف شكر منتدي اوفسينا الف شكر

بنفس اسم الملف ام باسم العميل

Dim ss As Long Path = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & "Capture2.jpg" 'لو عايز تغيير مكان الحفظ تقدر تغييره مكان كلمة desktop ولو عايز تغيير الاسم تقدر تغيير capture2 ss = Cells(235, 7).End(xlUp).Row ' ss دي عملتها عشان اخر سطر فيه بيانات 'celles(235,7) انا هنا حددت اخر سطر هيبحث من عنده لفوق و اخترت 7 عشان ياخد من اخر سطر في بينات العموم رقم 7 Set Rng = Sheets("اسم صفحة العمل").Range("e171:g" & ss) 'e171:g ده النطاق اللي عايز يتاخد ليه سكرين شوت ' اما باقي الكود مش فاكر والله كنت جايبه منين تقريبا من موقع اجنبي Call Rng.CopyPicture(xlScreen, xlPicture) With Sheets.Add .Shapes.AddChart .Activate .Shapes.Item(1).Select Set aChart = ActiveChart .Shapes.Item(1).Line.Visible = msoFalse .Shapes.Item(1).Width = Rng.Width .Shapes.Item(1).Height = Rng.Height aChart.Paste aChart.Export (Path) Application.DisplayAlerts = False .Delete Application.DisplayAlerts = True End With MsgBox "Saved to " & vbCr & Path, vbInformation, ""

وعليكم السلام 🙂 الاكسس يأخذ اعدادات "نسق الوندوز" Windows theme ، ليعطي برنامج الاكسس نفس شكل الوندوز من ناحية البراويز والاطارات ووو مثلا ، هذا الشكل يعطيه للوندوز فستا و وندوز 7 . وطبيعي ان يتغير مع الاصدارات الاخرى للوندوز ، بينما نستطيع ان نطلب من الاكسس ان يوقف التعامل مع نسق الوندوز ، فيعطينا هذا الشكل ، والذي به لن يتغير بتغيير الوندوز : . هذا الاعداد المؤشر عليه بعلامة الصح داخل المربع الاحمر في الصورة ادناه (لاحظ انه يخص قاعدة البيانات هذه فقط) : . احذف علامة الصح ، ثم شغل برنامجك على كمبيوترات تحمل وندوز مختلف 🙂 ولكن حذار ، فانت ستغير كل اشكال الكائنات في برنامجك ، فرجاء تجربة جميع نماذجك والتقارير قبل ان تعطي البرنامج للزبون 🙂 جعفر

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

شاهدي المرفق Tq.xlsm

السلام عليكم..تفضل ...الملف ..والكود المستخدم الخلطة.xlsm Sub حفظ_بي_دي_اف() Dim fName As String Application.ScreenUpdating = False With Worksheets("main") fName = Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) End With ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "d:\" & " " & Cells(5, 4).Text & Nombre & " " & QualityxlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False Application.ScreenUpdating = True End Sub

شاهد المرفق Tq.xlsm

تفضل العبقرى.xlsm

تفضل العبقرى.xlsm

اخي شاهد المرفق انفل موديول Module1 ..والفورم CalendarForm الي ملفك Tq.xlsm

اخي شاهد المرفق Tq.xlsm

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