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

يجب عرض التقرير بهذه الطريقة ثم الطباعة ليعمل الكود على تغيير خصائص الصفحة DoCmd.OpenReport "Labels_Table1", acViewPreview Reports("Labels_Table1").Printer.PaperSize = acPRPSB5

في ازرار الطباعة ضع الكود التالي قبل تنفيذ امر الطباعة و لا تنسى تغيير اسم التقرير تعيين نوع الخط للتسمية و مربع النص Dim ctl As Control For Each ctl In Reports!Report1.Controls If TypeName(ctl) = "TextBox" Then Reports!Report1.Controls(ctl.Name).FontName = "Arial" End If If TypeName(ctl) = "acLabel" Then Reports!Report1.Controls(ctl.Name).FontName = "Arial" End If Next ctl

اتفضل التعديل الحاق بشرط.accdb

المهم انك تستطيع المشاركة وبعدين انت تنور الدنيا كلها يا دكتور تحياتي

جرب استعمال هذه المعادلة في الخلية F1 =CONCATENATE(A1,B1,C1,D1,TEXT(E1,"yyyy/mm/dd")) بالتوفيق

تفضل هذا الموقع اجعله مرجع لك ستجد كل ما تحتاجه من اكواد microsoft

نقسم الكود لكي يسهل الشرح بهذا الكود تستطيع انشاء نسخة مماثلة لأي ملف مهما كان الامتداد Dim MyFile, DstFile As String Dim Syso As Object MyFile = File_Name ' Old File DstFile = CurrentProject.Path & "\Folder_Name\" & " New_File_Name" ' New File DBEngine.Idle Set Syso = CreateObject("Scripting.FileSystemObject") Syso.copyfile MyFile, DstFile Set Syso = Nothing لحذف اي ملف Kill " C:\\ File Path ....."

جرب المعادلة التالية في الخلية E1 =MID(A1,FIND("الاسم:",A1)+6,FIND("القسم",A1)-1-FIND("الاسم:",A1)-6) بالتوفيق

لماذا المفروض ؟ يمكن ان يكون مصدر التقرير جدول ويتم وضع المعايير المناسبة في كود وهذا مثال اخر لوضع كود لعمل فلتر للتقرير stLinkCriteria = "(" stLinkCriteria = stLinkCriteria & "[txtMovementDateStart] between #" & Format$(Form_frmVehicleDetailes.txtFrom, "yyyy/mm/dd") & "# And # " & Format$(Form_frmVehicleDetailes.txtTo, "yyyy/mm/dd") & "#" stLinkCriteria = stLinkCriteria & " AND " stLinkCriteria = stLinkCriteria & "[Id]=" & [Id] stLinkCriteria = stLinkCriteria & ")" 'Debug.Print stLinkCriteria DoCmd.OpenReport "repVehicleMovement", acViewPreview, , stLinkCriteria تحياتي

الجميع لا يظهر له تواجده .....

تفضل ... zaBarCode_Items.mdb

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

مفيش مشكلة جرب هذا المعادلة =MAX(IF(A:A=H2, D:D)) ولكن مع ضغط ctrl+shift+enter لأنها معادلة مصفوفات

للاسف 2013

ما نسخة الاوفيس لديك؟ ربما هي السبب

يمكنك وضع هذه المعادلة في الخلية C2 =IF(COUNTIFS(A$2:A2,A2,B$2:B2,B2)=0,"",IF(COUNTIFS(A$2:A2,A2,B$2:B2,B2)>1,MINIFS(C$1:C1,A$1:A1,A2,B$1:B1,B2),COUNT(C$1:C1)+1)) إن شاء الله تكون هي المطلوبة

استاذ محمد صالح هو انا مختش بالى من الرد .. هو ده المطلوب بالظبط شكر لتعبك ... وسامحنى

اخى الكريم / @محمد التميمي افتح الاستعلام New.rar

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

جزيتم خير

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

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

هل ما تذكره بعد التجربة ام مجرد تخمين ؟ على العموم جرب هذا التعديل If Me.ComboBox2.Value = cstr(ws.Cells(i, "AH").value) Then بالتوفيق

لو حذفت val هيبحث في النص ومش هيجيب الارقام يعني بحث باسم كلارك شوكة هيشتغل لو بحثة برقم السيارة مش هيظهر النتيجة في التكست بوكس

جرب هذا الماكرو Sub CONCATENATE_CELLS() Dim CONCELL, myvariant As String Dim LR As Long Dim i As Integer LR = Cells(Rows.Count, 1).End(xlUp).Row CONCELL = Range("A2").Value Range("f:f").Value = "" Range("f" & 1).Value = "RESULT" For x = 2 To LR If Range("A" & x).Value <> "" Then CONCELL = Range("A" & x) End If Range("F" & x).Value = CONCELL & Range("B" & x).Value & Range("C" & x).Value & Range("D" & x).Value & Format(Range("E" & x).Value, "YYYY/MM/DD") Next End Sub MERGE CELLS.xlsm

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

على افتراض ان الخلية التي تحتوي على الرقم هي A1 يمكنك استعمال المعادلة التالية =IF(A1>60,25,IF(A1>30,10,0)) وهي تحتوي على معادلتين اف متداخلتين بالتوفيق

يمكنك وضع المعادلة التالية في الخلية K2 =MAXIFS(D:D,A:A,H2) ويمكن سحب المعادلة لاسفل بالتوفيق

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

إن شاء الله يفيدك هذا التعديل تم وضع معادلا للجمع وشروط لاختبار الاجمالي مع المساحة ملف فارغ لحساب - حصر المزروعات - للرفع.xls

وهذا حل سهل عن طريق المعادلات ويوجد بالملف توضيح جمع أرقام العدد.xlsx

الكود صحيح صور رسالة الخطأ

اتفضل التعديل لابد انك تجعل الصورة قابلة للتمديد لجل تكون الخلفية شفافة New.zip

هذا هو الكود كامل Dim DB As Object Set DB = GetObject("ضع مسار قاعدة البيانات هنا فقط") DB.Application.Quit الواضح انك تجد صعوبة في اختيار مسار القاعدة أو استخدم نفس الكود وصور رسالة الخطأ الي تظهر امامك مع العلم مسار قاعدة البيانات هي قاعدة البيانات الخلفية المفصولة عن الواجهة ضع الكود في ازرار انهاء البرنامج بحيث تضمن اغلاق الواجهات قاعدة البيانات البعيدة

المشكلة في مرجع الاسم Isuzu هو الخلية الأولى فقط وليس الجدول ككل ولاصلاح ذلك من تبويب formulas المعادلات Name manager ادارة الاسماء حدد ايسوزو من قائمة الاسماء بالأعلى ثم قم بتحديد النطاق الخاص به بدون العنوان سيظهر معك في مربع الاسم في شريط الصيغة جدول10 تقريبا

اشكرك استاذى أ / محمد صالح بارك الله فيك وظادك من فضله اللهم امين احترامى لك اخى

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم Private Sub nihayat_altarkhis_Exit(Cancel As Integer) If [aintiha alsijil] > [nihayat altarkhis] Then DoCmd.CancelEvent MsgBox "التاريخ اكبر من التاريخ المطلوب" ElseIf [nihayat aldaman albankii] > [nihayat altarkhis] Then DoCmd.CancelEvent MsgBox "التاريخ اكبر من التاريخ المطلوب" End If End Sub Database72.rar تحياتي

حسب فهمي للصورة النهائية للمطلوب تفضل هذه أكواد استيراد واستعراض وتصدير Private Sub estrad_Click() If IsNull(Me.FilePath.Value) Then MsgBox "يجب تحديد مسار الملف اولاً", vbCritical + vbMsgBoxRight, "تنبيه" Else Dim ImpEX As String Dim strSQL As String ' حذف محتويات الجدول strSQL = "DELETE tbl1.* FROM tbl_Items;" DoCmd.SetWarnings False DoCmd.RunSQL strSQL DoCmd.SetWarnings True ' استيراد جدول الإكسل إلى جدول الأكسس المطلوب ImpEX = Me.FilePath.Value DoCmd.TransferSpreadsheet acImport, 8, "tbl_Items", ImpEX, True Me.Requery MsgBox "أكسس استورد البيانات المطلوبة من ملف إكسل بنجاح" End If End Sub Private Sub FileDialog_Click() With Application.FileDialog(3) .Title = "اختر ملفا لاستيراده" .Filters.Clear .Filters.Add "Excel 2007", "*.xlsx" .Filters.Add "Excel 2003", "*.xls" .AllowMultiSelect = False .InitialFileName = "" If .Show = True Then Me.FilePath.Value = .SelectedItems(1) Else MsgBox "تم إلغاء الإجراء." End If End With End Sub Private Sub tasder_Click() On Error GoTo err: DoCmd.OutputTo acOutputTable, "tbl_Items", acFormatXLSX, , False MsgBox "أكسس صدر البيانات المطلوبة إلى ملف إكسل بنجاح" Exit Sub err: MsgBox "مشكلة بتصدير الملف" End Sub بالتوفيق

لن تجد ما يحقق غرضك مائة بالمائة ولكن يمكنك تطويع الفكرة لما يناسب ملفك لتحويل المعادلة الى كود يمكنك استعمال هذا الإجراء ويمكنك تغيير النطاق E3 كما تشاء With Range("e3") .Formula = "put your formula here" .Value = .Value End With التوفيق

اعطيني الكود بعد التعديل خلينا نشوف كيف استخدمته

يمكنك استعمال المعادلة التالية في الخلية C2 =IF(B2="",DATEDIF(A2,TODAY(),"d"),DATEDIF(A2,B2,"d")) وبالنسبة للتنسيق الشرطي يمكنك استعمال المعادلة =b2="" وتطبق على العمود C بالتوفيق

أولا أنصح بالتحول إلى إصدار أوفيس أعلى من 2003 تم تغيير امتداد الملف لتعمل دالة iferror تم الحساب على تاريخ نهاية الاستحقاق R7 بالتوفيق بيان اجارات الشركة.xlsx

الكود المستخدم هو التالي On Error Resume Next Dim MyFile, DstFile As String Dim Syso As Object Dim db As DAO.Database Dim rs As DAO.Recordset '==================================== ' تحديد جدول البيانات Set rs = CurrentDb.OpenRecordset("SELECT * FROM Table1 where nategacode=2") rs.MoveFirst While (Not rs.EOF) ' استخراج اسم الملف من رابط الصورة داخل قاعدة البيانات MyFile = CurrentProject.Path & "\savefrom\" & Right$(rs.Fields("imagepath"), Len(rs.Fields("imagepath")) - InStrRev(rs.Fields("imagepath"), "\")) ' تحديد مسار المجدل الثاني و اضافة اسم الصورة المستخرج من الكود اعلاه DstFile = CurrentProject.Path & "\saveto\" & Right$(rs.Fields("imagepath"), Len(rs.Fields("imagepath")) - InStrRev(rs.Fields("imagepath"), "\")) 'البدء في انشاء نسخة مماثلة من الملف المحدد اعلاه DBEngine.Idle Set Syso = CreateObject("Scripting.FileSystemObject") ' مسار الملف الأصلي و المسار الجديد Syso.copyfile MyFile, DstFile Set Syso = Nothing 'حذف الملف من المجلد الرئيسي بعد نسخه Kill MyFile 'تعديل المسار داخل الجدول rs.Edit rs.Fields("imagepath").Value = DstFile rs.Update rs.MoveNext Wend rs.Close Set rs = Nothing

تفضل List.zip

تفضل الكود و التعديل On Error Resume Next Dim MyFile, DstFile As String Dim Syso As Object Dim db As DAO.Database Dim rs As DAO.Recordset '==================================== Set rs = CurrentDb.OpenRecordset("SELECT * FROM Table1 where nategacode=2") rs.MoveFirst While (Not rs.EOF) MyFile = CurrentProject.Path & "\savefrom\" & Right$(rs.Fields("imagepath"), Len(rs.Fields("imagepath")) - InStrRev(rs.Fields("imagepath"), "\")) DstFile = CurrentProject.Path & "\saveto\" & Right$(rs.Fields("imagepath"), Len(rs.Fields("imagepath")) - InStrRev(rs.Fields("imagepath"), "\")) DBEngine.Idle Set Syso = CreateObject("Scripting.FileSystemObject") Syso.copyfile MyFile, DstFile Set Syso = Nothing Kill MyFile rs.Edit rs.Fields("imagepath").Value = DstFile rs.Update rs.MoveNext Wend rs.Close Set rs = Nothing MsgBox "تم نقل الصور بنجاح", vbInformation + vbMsgBoxRight, "تأكيد" DoCmd.Requery فصل صور الطلاب.zip

ما يحتاج و لو حبيت تعلن عنه في النهاية هو String القي نظرة على المثال المرفق هذاDatabase2.mdb

انسخ و الصقها مثل ماهي بدون تغيير Dim DB As Object dbPath = CurrentProject.FullName Set DB = GetObject(dbPath) DB.Application.Quit من هذا السطر تتحكم في المسار و حاليا المسار هو قاعدة البيانات التي تعمل عليها dbPath = CurrentProject.FullName تفضل هذا المثال Database2.mdb

حسب فهمي للمطلوب تم إضافة عمود فارغ بعد العميل رقم 14 حتى تنتظم معادلات أرقام الأعمدة تم إضافة كود لجلب جميع أسماء العملاء وأرقامهم في العمود A & B تم وضع معادلة للبحث في قائمة العملاء هذه حتى لا نحتاج سوى رقم العميل ويظهر اسمه مباشرة تم وضع كود في حدث تغيير الخلية A2 وكتابة رقم العميل يتم تحديث قائمة العملاء ثم الانتقال إلى الخلية الخاصة باسم العميل بالتوفيق حسابات العملاء الجديد.xlsb

عمل رائع اخي الفاضل احمد زمان واضافة حسب مطلوب الاخ يضاف معادلة صفيف =IFERROR(INDEX(B$5:B$19;MATCH(1; ((COUNTIF(B4:B$4;B$5:B$19)=0)*(COUNTIF(B$5:B$19;B$5:B$19)>=2));0));"") او المعادلة =LOOKUP(2;1/(((COUNTIF($L$4:L4;$B$5:$B$23)=0)*(COUNTIF($B$5:$B$23;$B$5:$B$23)>1)));$B$5:$B$23) فضلا انظر للمرفق takrir (2).xlsx

تقدر تستفيد من خاصية ازالة التكرار الموجودة في اكسل بضغطة زر تصلل القائمة كاملة ( الرقم ؟ الاسم / التاريخ ) ..داتا ,,ازالة التكرار ..تشيل علامة الصح من ( الرقم ) لعدم وجود تكرار ..وبالتوفيق