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

تم التعديل على الكود Sub transfer_Unique_New() Dim D As Worksheet, R As Worksheet Dim RoD%, RoR%, I%, m%, ky Dim RGD As Range, RGR As Range Dim Arr_1, Arr_2, Arr_3 Dim dic_1 As Object Dim dic_2 As Object Dim dic_3 As Object Set D = Sheets("Data"): Set R = Sheets("Repport") Set RGD = D.Range("a2").CurrentRegion: RoD = RGD.Rows.Count Set RGD = RGD.Offset(1).Resize(RoD - 1).Columns(11) Set RGR = R.Range("A2").CurrentRegion: RoR = RGR.Rows.Count Set dic_1 = CreateObject("Scripting.Dictionary") Set dic_2 = CreateObject("Scripting.Dictionary") Set dic_3 = CreateObject("Scripting.Dictionary") If RoR > 1 Then Set RGR = RGR.Offset(1).Resize(RoR - 1) RGR.ClearContents End If For I = 1 To RoD - 1 If Len(RGD.Cells(I)) > 1 Then x = RGD.Cells(I).Row Arr_1 = Application.Transpose(D.Cells(x, 1).Resize(, 3)) Arr_1 = Application.Transpose(Arr_1) Arr_1 = Join(Arr_1, "*") '''''''''''''''''''''''''''''''' Arr_2 = Application.Transpose(D.Cells(x, 4).Resize(, 6)) Arr_2 = Application.Transpose(Arr_2) Arr_2 = Join(Arr_2, "*") '+++++++++++++++++++++++++++++++ Arr_3 = Application.Transpose(D.Cells(x, "j").Resize(, 2)) Arr_3 = Application.Transpose(Arr_3) Arr_3 = Join(Arr_3, "*") dic_1(RGD.Cells(I).Value) = Arr_1 dic_2(RGD.Cells(I).Value) = Arr_2 dic_3(RGD.Cells(I).Value) = Arr_3 End If Next m = 3 For Each ky In dic_1.keys R.Cells(m, 1).Resize(, 3) = Split(dic_1(ky), "*") m = m + 1 Next m = 3 For Each ky In dic_2.keys R.Cells(m, 4).Resize(, 6) = Split(dic_2(ky), "*") m = m + 1 Next m = 3 For Each ky In dic_3.keys R.Cells(m, 10).Resize(, 2) = Split(dic_3(ky), "*") m = m + 1 Next R.Range("A2").CurrentRegion.Value = R.Range("A2").CurrentRegion.Value Set dic_1 = Nothing: Set dic_2 = Nothing: Set dic_3 = Nothing Set D = Nothing: Set R = Nothing Set RGD = Nothing: Set RGR = Nothing End Sub الملف من جديد Mostakhlasat_New.xlsm

السلام عليكم الأساتذة الأفاضل/ الإخوة الكرام هذا تطبيق متواضع أنجزته باعتماد المؤشر العلمي IBM لتييم الوزن ما رأيكم فيه كتطبيق من الناحية التقنية؟ وكذلك مناسبة لقياس وتقييم وزنكم كلمة مرور حماية الأكواد هي:123 والسلام عليكم poids v2.xlsm

السلام عليكم 🙂 وهذا دلوي 🙂 Private Sub cmb_Month_NotInList(NewData As String, Response As Integer) Call Items_NotInList("cmb_Month", NewData, Response) End Sub Private Sub STATION_OUT_DEP_NotInList(NewData As String, Response As Integer) Call Items_NotInList("STATION_OUT_DEP", NewData, Response) End Sub Private Sub Items_NotInList(fld As String, NewData As String, Response As Integer) Response = acDataErrContinue Me(fld).Undo End Sub . جعفر 1185.COMBO BOX ERROR.accdb.zip

Private Sub STATION_OUT_DEP_NotInList(NewData As String, Response As Integer) MsgBox "الادخال خاطيء ...انت محدد بالقائمة ... يرجى عدم ادخال اي شيء آخر", vbOKOnly Response = acDataErrContin End Sub فقط ضع هذا الكود اسفل الرسالة Response = acDataErrContin لست بحاجة لاستخدام كود إخفاء رسائل الاستعلام هذا DoCmd.SetWarnings False الملف بعد التعديل COMBO BOX ERROR.accdb

هنا البداية : . والخطوة التالية هي ، متابعة الاسئلة في المنتدى (وخصوصا الاسئلة التي تمت الاجابة عليها) ، فقم انت بالرد على السؤال ، ثم انظر لرد بقية الاعضاء ، ومنها ستتعلم ان السؤال له اكثر من جواب 🙂 جعفر

تم التعديل قليلاً على الموضوع السابق لادراج الصفوف المكررة وليس فقط تحديدها Find_dup_rows_NEW.xlsm

أ.husseinharby فضلا ليس أمرا .. رجاء مراجعة الرابط التالى

وعليكم السلام 🙂 اخوي رمهان ، حيا الله هذه الطلّه ، ولو من الجوال 🙂 اخوي حسين ، الظاهر انك خبير في كيفية لفت نظر اخوي رمهان ، وجعله يطل علينا ، فلوسمحت كثّر من هذه الاسئلة 🙂 ونعود لنفس اللبس في موضوعك السابق: اذا كان قصدك اول ثلاث ارقام = 777 ، فالجواب مثل ما قال اخوي رمهان: اذا كان الحقل رقم If Left(Me.serh_Barcod, 3 )= 777 Then او اذا كان الحقل نص If Left(Me.serh_Barcod, 3 )= "777" Then ومثال مني If InStr(Mid(Me.serh_Barcod, 1,3), 777)>0 Then . اما اذا كان قصدك اول ثلاث ارقام تحتوي على الرقم 7 ، فالجواب سيكون: اول 3 احرف/ارقام من الحقل Mid(Me.serh_Barcod, 1,3) فيصبح كود البحث في الثلاث احرف/ارقام الاولى If InStr(mid(Me.serh_Barcod, 1,3), 7)>0 Then . جعفر

مشاركه مع احبتي وعذرا اكتب من الجوال مع العلم ان سؤالك فيه لبس شويه انت تقول اول ثلاث ارقام تساوي ٧ وهذا متناقض حسب فهمي تقول اول ثلاث ارقام تساوي ٧٧٧ وهنا استخدم نفس تعبيرك وباستخدام الداله لفت وبعدد ٣ للباراميتر If Left(Me.serh_Barcod, 3 )= 777 Then وقد تحتاج لوضع الرقم ٧٧٧ في علامة تنصيص كنص بالتوفيق

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

السلام عليكم بعد اذن اسناذ @jjafferr واستاذ @essam rabea مرفق الملف الاصلي للكود انا عملته لاحد الاخوه حول القوائم الفرعية كان الكود لايعمل على اكسس 2010 الا بعد ماقمت بتثبيت اكسس 2016 في جهازي تحياتي test.accdb

وعليكم السلام مثلا اسم الزر الاول cmd_1 ، واسماء الازرار الاخرى cmd_2 و cmd_3 ، على حدث النقر على الزر cmd_1 ، ضع هذا الكود cmd_2.Enabled = Not cmd_2.Enabled cmd_3.Enabled = Not cmd_3.Enabled جعفر

السلام عليكم ورحمة الله وبركاته هذا الموضوع اُثير اكثر من مرة في الآونة الاخيرة ، ورأيت من الافضل ان اضع مثال ليقتدي به الجميع وقبل ان نبدأ ، اود ان اشير الى انني اعمل على اكسس 32 بت ، ولا املك نسخة من اكسس 64 بت احب ان اشير الى الرابط الذي شرحت فيه ان مايكروسوفت توصي بتنصيب الاوفيس / اكسس 32 بت ، بغض النظر عن نوع الوندوز المنصّب على الكمبيوتر ، سواء كان 32 بت او 64 بت: http://www.officena.net/ib/topic/64036-هل-استخدم-اوفيس-32-بت-او-64-بت/ ولكن ، ماذا نفعل اذا عملنا برنامجنا على اكسس 32 بت ، واتضح ان الزبون عنده جهاز فيه اكسس 64 بت المثال التالي يشتغل على 32 بت و 64 بت ، ونستطيع ان نستفيد منه لعمل برنامجنا البرنامج المرفق ، بعد فك الضغط ، سيحتوي على 3 برامج: . هذا برنامج No_Password_BE.accdb ، وبه جدول واحد ، ولا يحتاج الى كلمة سر لفتحه: . هذا برنامج Password_is_jj_BE.accdb ، وبه جدول واحد ، وكلمة السر لفتحه هي jj: . البرنامج: JStreetAccessRelinker2.accdb من الرابط http://www.jstreettech.com/downloads.aspx ، وبه ماكرو ووحدات نمطية تعمل على 32 بت و 64 بت (فالفضل في هذا المثال يعود للبرنامج وليس لي ) ، وقد قمت بإضافة نموذج لربطه مع احد برنامج الجداول اعلاه ، ومبدئيا فهو مرتبط مع البرنامج No_Password_BE.accdb ، . وعند فتح البرنامج لأول مرة ، سوف يفتح نافذة تطلب معرفة مكان برنامج الجداول No_Password_BE.accdb ، وتستطيع ان تنقر على الزر Link Another BE ، وستفتح لك نافذة تطلب منك معرفة مكان برنامج الجداول الجديد الذي تريد ان تربطه (بدل البرنامج No_Password_BE.accdb) : . وبما ان البرنامج هذا محمي بكلمة سر ، فسوف تظهر لك نافذة لإدخال كلمة السر (لاحظ ان الادخال مشفر) : . وعندما يتم الربط ، سترى رسالة التاكيد: . الرجاء من الشباب الذين لديهم نسخة من الاكسس 64 بت ، التاكد من ان البرنامج يشتغل على كمبيوترهم بدون اخطاء. عندما نريد ان نعمل برنامج يشتغل على النسختين 32 و 64 بت ، فكود النماذج هو نفسه بين نسختي 32 بت و 64 بت ، والشئ الوحيد الذي يتغير هو دوال الوحدات النمطية API ، والكود الذي ينادي هذه الوحدات (بغض النظر سواء كان في نموذج او في وحدة نمطية مستقلة) ، هنا سوف اعطي مثال واحد من الكود عن طريقة العمل للنسختين 32 و 64 بت: الكود التالي يستعمل دالة API فتح نافذة اختيار ملف ، والدالة هي 32 بت (لاحظ comdlg32.dll ) : Private Declare Function GetOpenFileName Lib "comdlg32.dll" _ Alias "GetOpenFileNameA" (OPENFILENAME As tagOPENFILENAME) As Long الان اذا اردنا ان نجعل هذه الداله API تعمل على 64 بت كذلك ، فالكود يجب ان يكون: #If VBA7 Then 'هذه لنسخة 64 بت Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" _ Alias "GetOpenFileNameA" (OPENFILENAME As tagOPENFILENAME) As Boolean #Else 'وهذه لنسخة 32 بت Private Declare Function GetOpenFileName Lib "comdlg32.dll" _ Alias "GetOpenFileNameA" (OPENFILENAME As tagOPENFILENAME) As Long #End If ولاحظ في كود البرنامج ، انه تم جمع جميع الدوال مع بعض ، وجمعها في if# و else# و end if# واحدة. وهناك اصدار جديد لكود الربط ، ويمكن انزاله من هنا: http://www.jstreettech.com/files/JStreetAccessRelinker2.zip جعفر 238.Work_on_32Bits_and_64Bits.zip

ربما لم افهم المطلوب بشكل صحيح او انك لم توضح المطلوب بشكل واضح كان استفساري هل ترغب في اضهار الرصيد قبل اي عملية ايداع او صرف مثل في الصورة المرفقة بنهاية يوم 4/3/2020 كان لدينا رصيد 7,610,000 مع بداية يوم 5 وقبل اي عملية كان الرصيد المتوفرة نفس مبلغ الاقفال ليوم 4 ثم حصلت عملية ايداع واحدة بمبلغ 90,000 وبنهاية يوم 5 اصبح الرصيد الاجمالي 7,700,000 وهو ناتج الرصيد السابق زائد مبلغ الايداع وكذلك يوم 6 الرصيد المتوفر هو رصيد الاقفال ليوم 5 مبلغ 7,700,000 ثم حصلت عملية صرف لمبلغ 123,500 واصبح الرصيد المتوفر ليوم 7 مبلغ 7,576,500 وهو اجمالي المبلغ الافتتاحي لليوم السابق ناقصا المبلغ المصروف الف شكر اخي واستاذي @أحمد الفلاحجى

اخى @رعد داود كيف والظاهر فالصوره خلاف كلامك ممكن توضح بصوره من نفس المرفق وتشرح عليه فالصوره السابقه توضح ان الرصيد قبل تاريخ 5/3/2020 هو 7610000 ثم تمت حركه وارد بمبلغ 90000 والنهائى 7700000 يوم 6 سابق 7700000 وتم صرف 123500 نهائى 7576500 فياريت توضح كلامك بصوره وارقام من خلال المرفق المعدل لاخى خالد @kha9009lid جزاه الله خيرا هو واخوانى الافاضل بارك الله فيهم بالتوفيق

جرب هذا الكود If NewData = Not Null Then Me.STATION_OUT_DEP = Null Else Response = acDataErrContinue End If

جرب إزالة الرسالة والاكتفاء Response = acDataErrContin

اخي الكريم الملف الاول مختلف عن الملف الثاني على كل حال ممكن توضيح اسماء الحقول المراد دمجها تحياتي

هذه المعلومة غير صحيحة ، فالماكرو يحتاج كود كذلك !! تفضل 🙂 اليك طريقتين: . هلا والله بالحلوين 🙂 جعفر Disable_Command_Buttons.zip

تفضل اخي طلبك في الرابط ده وهذا برنامج صادر وارد نفس الفكره

أ.Q8MBK اعتقد لو نقلت طلبك الى القسم المدرج رابطة هنا سيكون أفضل https://www.officena.net/ib/forum/157-إعلانات-شخصية-للاعضاء-فقط-فى-مجال-الموقع/

السلام عليكم 🙂 هذه جميع مكتبات مايكروسوفت ، بصيغة نواة 32bit ومقابلها نواة 64bit ، في ملف Win32API_PtrSafe.TXT https://www.microsoft.com/en-us/download/details.aspx?id=9970 وقد ارفقت الملف لسهولة الوصل اليه 🙂 جعفر Win32API_PtrSafe.zip

السلام عليكم بعد إذن أخونا مهند أهلا ومرحبا أخي الكريم محمد هذه أول مشاركة لك لذلك سأرد عليك ولكن برجاء الإلتزام بقواعد المنتدي لنشر مسألتك لكي توفر الوقت علي نفسك وعلي من يريد المساعدة أخي الفاضل لو فرضنا أن أحد هذه الأرقام في الخلية A2 مثلا فلتضع المعادلة التالية في اي خلية ولتكن B2 =DATE(RIGHT(A2,4),MID(A2,4,2),LEFT(A2,2)) ثم تنسق تلك الخلية الجديدة (B2) بتنسيق التاريخ الذي تريده مرفق ملف به ماطلبت mohamed elzan.xlsx

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

اهلا بك اخى واستاذى العزيز رمهان عودا حميدا ان شاء الله متغبش كتير عننا احسنت اخى واستاذى @رمهان وفعلا يحتاج لوضع = "777" جزاك الله خيرا نتعلم كل يوم جديد منكم اساتذتى فليس لنا مورد للتعلم سوى مشاركتكم اخوانى واساتذتى بارك الله لنا فيكم وزادكم الله من فضله وعلمه تحياتى وتمنياتى لكم وللجميع بالتوفيق

وعليكم السلام ومشاركه لاخى ناقل جزاه الله خيرا ان كنت فهمت طلبك بشكل صحيح اذا كان اول رقم =7 او الثانى =7 او الثالث =7 وان كان 3 الاولى = 7 عدل or الى and If Mid(text1, 1, 1) = 7 Or Mid(text1, 2, 1) = 7 Or Mid(text1, 3, 1) = 7 And Me.text2 = 7 Then MsgBox "تنبيه" Me.Undo DoCmd.CancelEvent End If ويمكن اختصار الكود بالمشاركه الاولى الى If Mid(text1, 1, 1) = 7 And Mid(text1, 2, 1) = 7 And Mid(text1, 3, 1) = 7 And InStr(Me.text2, 7) > 0 Then MsgBox "تنبيه" End If جرب ووافنا بالنتيجه تقبلوا تحياتى وتمنياتى لكم وللجميع بالتوفيق

جرب هذا ...... If Mid(Me.text1, 1, 1) = 7 And InStr(Me.text2, 7) > 0 Then MsgBox "الرقم الأول" ElseIf Mid(Me.text1, 2, 1) = 7 And InStr(Me.text2, 7) > 0 Then MsgBox "الرقم الثاني" ElseIf Mid(Me.text1, 3, 1) = 7 And InStr(Me.text2, 7) > 0 Then MsgBox "الرقم الثالث" End If

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

ولا يهمك اخى احاول قدر معرفتى مساعدتكم اتفضل اخى حسين ان شاء الله يكون ما تريد تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق A_Downloads.rar

او ، وبدون الاختيار من المكتبة ، تستطيع استعمال: dim MAINMENU as object ولكن لا يُفضل استعماله وانت في حالة تصميم البرنامج ، لأن طريقة الاستاذ عصام (وتسمى Early Binding ، اي الربط المسبق) ، وعند الضغط على النقطة او المسافة ، فإن البرنامج سيساعدك ويعطيك خيارات للأمر الذي تكتبه (مثل بقية اوامر الاكسس) ، ولكن لما تنتهي من البرنامج ، يمكنك استعمال طريقتي (والتي تُسمى Late Binding ،اي الربط المتأخر) ، وميزته ، انه في جهاز المستخدم ، لن يحصل على الخطأ الذي حصلت عليه ، بسبب عدم اختيار المكتبة 🙂 جعفر

تمام أخي جعفر بارك الله فيك

وعليكم السلام ورحمة الله وبركاته يمكنك استخدام دالة Right بالشكل التالي Expr1: Right([Text1];2) ولدمجين الحقلين كالتالي Expr1: Right([Text1];2) & [Text2] حيث Text1 هو الحقل المراد حذف الرقمين باليسار منه و Text2 الحقل الثاني المراد دمجه مع الاول تحياتي

long يفتش فقط عن الارقام وانت تريد ان تفتش عن نص لأن F321112568 ليست رقماً لذا يجب كتابة Dim nat As String أو $Dim nat

وهذه طريقة أخرى .. اقتبستها من مشاركة للأخت زهره to word.rar

السلام عليكم تفضل اخي الكريم حسب مافهمت من طلبك (للتجربة) اول شيء تختار اسم الموظف ثاني شيء تختار اسم ملف الورد من النافذه ثالث شيء للتصدير تحياتي to word.rar

في الصورة التالية تفصيل لكل عناصر المعادلة

في كل الاكواد داخل الملف استبدل حرف A الى اسم العامود الذي تريده

ممكن ذلك من خلال هذا التعديل على الكود Option Explicit Sub Find_Dupl_Rows_new() Dim I%, Ro, m% Dim REP As Range, My_Rg As Range Dim COl As Collection Dim Arr, n Set COl = New Collection Set My_Rg = Range("A1").CurrentRegion Ro = My_Rg.Rows.Count Set My_Rg = My_Rg.Offset(1).Resize(Ro - 1) My_Rg.Interior.ColorIndex = xlNone Range("E2").Resize(Ro - 1).ClearContents Range("G2:K2").Resize(Ro - 1).Clear For I = 2 To Ro Arr = Application.Transpose(Application.Transpose _ ((Cells(I, 2).Resize(, 3)))) Arr = Join(Arr, "*") On Error Resume Next COl.Add I, Arr If Err.Number <> 0 Then m = m + 1 Cells(I, 5) = "Duplicate" Cells(I, 5).Interior.ColorIndex = 40 If REP Is Nothing Then Set REP = Cells(I, 2).Resize(, 3) Else Set REP = Union(REP, Cells(I, 2).Resize(, 3)) End If 'REP End If 'Err Next I On Error GoTo 0 If Not REP Is Nothing Then REP.Interior.ColorIndex = 40 MsgBox "You have :" & m & " duplicate Rows" n = REP.Areas.Count m = 1 For I = 1 To n Range("G1").Offset(m).Resize(REP.Areas(I). _ Rows.Count, 3).Value = REP.Areas(I).Value Range("j1").Offset(m) = REP.Areas(I).Address Range("K1").Offset(m) = REP.Areas(I).Rows.Count m = m + REP.Areas(I).Rows.Count Next '================================= With Cells(2, "g").Resize(m - 1, 5) .Borders.LineStyle = 1: .Font.Size = 16 .Font.Bold = True: .Interior.ColorIndex = 28 .InsertIndent 1 End With '========================= Else MsgBox "Not duplicate Rows " End If Set COl = Nothing: Set REP = Nothing End Sub

بعد اذن استاد طارق محمود ولاثراء الموضوع جرب المرفق 1 انسخ المجلد المسمى mydata في :d 2 افتح الملف المسمى main واضغط زر استعلام سيأتي ببيانات حسب الرقم في العمود A ملاحظة تم تغيير اسماء الشيتات ليعمل الكود بكفاءة ارجو ان يكون ما تريد my data.rar

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

اهلا بك اخى الكريم بالمنتدى-تفضل طريقة سهلة لتحويل ملفات الورد لإكسيل دون الحاجه لبرامج تحويل الملفات 1- إفتح ملف الورد المراد تحويله لإكسيل word .doc 2- قم بحفظة على صورة ملف بصيغة اتش تي ام ال أو صفحة إنترنت باسم الملف المراد تحويلة file / save as / web page format 3 – قم بفتح ملف اكسيل جديد open new xls 4- اضغط على فتح في قائمة ملف open /brwos/ select file 5- إختار الملف بصيغة الاتش تي ام ال السابق تحويله file html. 6- قم بحفظ الملف ذاته بأختيار صيغة اكسيل ورقة عمل باختيار احد صيغ الأكسيل باصداراته المراد انشاؤها file/ save as/ xls 97/2033. بذلك يكون تم تحويل الملف ويمكن بسهولة التعديل عليه وعمل كافة الصيغ والمعادلات المطلوب . والله الموفق وكمان يمكنك الإستعانة بهذا الرابط : https://www.dorar-aliraq.net/threads/411533-طريقة-نقل-جدول-بكامل-بياناته-من-ملف-Word-الى-ملف-Excel وهذا فيديو ايضا للشرح نقل البيانات من الوورد إلى الاكسل Explain how to insert a word file inside the worksheet in Excel

حبيت انبه اخي جعفر بان المسؤول عن كشف نوع الاوفيس من ناحية 32 بت او 64 بت هو التعبير التالي : #If Win64 Then ' Win64 #Else ' win 32 #End If وليس vba7 فهذه لكشف اصدار محرر الفيجول بيسك والذي سيعتبر لكشف اصدار الاوفيس حيث 7 تشير لاوفيس 2010 وما فوق ! هذا وسيكون لي محاولة وبموضوع جديد حول الاصدارين 32 بت و 64 بت الفرق والاعتبارات ! تحياتي للجميع