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

عملية البحث طبيعية ولا مشكلة في الكود ويرجع سبب الحصول على أرقام أخرى أن عملية البحث غير مطابقة وإنما باللواصق (ما قبلها وما بعدها) "*" & Me.TextBox1 & "*" فلو بحثنا عن الرقم 2 يجلب لنا 2 و 12 و 22 و 25 و 32 وهكذا وإذا أردنا أن يكون البحث عن الأرقام مطابقا يجب إضافة شرط لمعيار البحث باستبدال السطر الثاني إلى هذا السطر clé = IIf(Me.combobox1.Value = "الرقم" Or Me.combobox1.Value = "عدد الحروف" Or Me.combobox1.Value = "عدد الكلمات", Me.TextBox1, "*" & Me.TextBox1 & "*"): n = 0 بالتوفيق

عليكم السلام يمكنك وضع هذه المعادلة في الخلية F3 =(SUM(B3,E3)-SUM(A3,D3))*24 بالتوفيق

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

افضل طيقة بأن تقوم بتصميم التقارير على ملف وورد مرفق مثال لإرسال البيانات من الاكسس الى الوورد سيتم حفظ ملف الوورد بصيغتين Word و PDF RepToWord.zip

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

وعليكم السلام ورحمة الله وبركاتة اخي احمد الطرفاوي تفضل Sub tast() Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets("Sheet1") ss = ws.Cells(Rows.Count, 1).End(xlUp).Row k = 0 For Each C In ws.Range("A2:A" & ss) If C > 1 Then ws.Cells(C.Row, 2).Value = "ضع المعادلة هنا" k = k + 1 End If Next C End Sub

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

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

اخي الفارس محمد رجب تفضلنسخة من البحث بالليست بوكس (1).xlsm

السلام عليكم ورحمة الله وبركاتة تفضلنسخة من البحث بالليست بوكس (1).xlsm

@الفارس محمد رجب ولكن اين الكود الذي حاولت القيام به؟!! بالمناسبة موضوعك ليس بالمعقد ، يمكنك البحث عن مواضيع قد تم تناولها مسبقا وتعديله بناء على احتياجاتك. تحياتي

السلام عليكم الفارس محمد رجب اجعل دائماً وأبداً التحية ببداية المشاركة وليس عنواناً لها .فعليك بتغيير عنوان المشاركة بما يتناسب مع طلبك , وشكراً

xlsاوفسينا.xls

تفقيط من "أبو هادي" حذفت المرفق السابق لاشتباهي أن هناك خطأ وربما هو متعمد من المبرمج. لاحظت أن البليون بالإنجليزي يأتي بعد المليون ولكنه يأتي بالعربي بعد المليار، وأنا لم أبحث ربما يكون صحيحا وربما لا. طباعه الشيكات_02.mdb

هل text1 و text2 رقمي ام نص؟ ان كان نصي فهو صحيح .. وان كان رقمي فليس صحيح ...لانه يحتمل ان يكون لايساوي او اكبر من او اصغر من او يساوي

شكر وتقدير واحترام من اخيك

اذا كنت تقصد اظهار التقويم لاختيار التاريخ عندها يمكن استخدام اداتين date picker او calendar . هذه محاولة بعد القيام بإضافة فورم التقويم والقيام ببعض التعديلات . قم بالنقر مرتين علي خلية التاريخ وسيظهر التقويم . ولكن هذا يتوقف على اصدار الاوفيس اشك انها تعمل مع الإصدارات قبل 2016 واذا واجهتك مشكلة بإظهار رسالة بعدم وجود كائن عنده يجب تنصيبه حتى يظهر لك . حاليا يعمل معي باستخدام بإصدار 2019 تحياتي مطلوب تعديل.xlsm

تفضل هذا الملف .على الرغم ان كان عليك من البداية رفع ملف بالمشاركة فلا تعنى أى مشاركة شيء بدون ملف يدعمها Colored.xlsb

لم اجد تفاعل أو اى رد يدل على نجاح فاعلية التطبيق والتجربة وهذه القواعد للتجربة تم مراعاة عند كتابة الأكواد العمل على كل من النواتان 32x , 64x استاذى الجليل الاستاذ @Moosak اردت فقط الاطمئنان على المكتبة العامرة Moh3sam.zip

السلام عليكم نظرا لبعض طلبات الاعضاء الكرام . خاصة ممن يقومون بعمل برامج من أجل كسب العيش أعانهم الله فيما يخص حماية الاكواد التي بملفاتهم لانه عادة ما تحصل سرقة لبرامجهم و هذا بسبب ان أكسل لا يوفر الخماية الكاملة اضافة الى أن هناك برامج تقوم بكشف كلمات سر الملف ببساطة. لذلك اردت أن أقدم فكرة و هي تحويل الكود البرمجي الى ملف DLL مما يوفر حماية قوية للملف عن طريق برنامج vbacompiler for excel و لكن للاسف غير مجاني و هو برنامج يقوم بتحويل الاكواد بالملف الى ملف DLL و تغيير الاكواد بالملف لتستدعى ملف DLL الذي تم انشاؤه و يعمل الملف بكفاءءة عالية لقد قمت بالتجريب و فعلا نتيجة رائعة. يمكنك تحميل البرنامج كنسخة تجريبية . و بالنسبة للذين يعملون البرامج و يبيعونها و يكسبون العيش مننها يمكنهم شراء النسخة الكاملة كيف تحمي ملفك ؟ يمكنك وضع كود خاص بكلمة السر و السريال نمبر للهارد ديسك و ييمكنك وضع الكود التالي عند فتح الملف WORK BOOK OPEN يعني اذاكان رقم السريال نمبر هو مثلا : FFFFF-FFFFF-FFFFF ادخل الرقم السري 222222 و اذا كان خطأا اغلق الملف Private Sub Workbook_Open() Dim RAD As String If CreateObject("Scripting.FileSystemObject").GetDrive("C:\").SerialNumber = "FFFFF-FFFFF-FFFFF" Then RAD = InputBox("Enter password:") If LCaseRAD <> "222222" Then ActiveWorkbook.Close False End If End Sub و بعد الانتهاء من عمل ملف افتح برنامج vbacompiler for excel و جول ملفك الى ملف جديد معه ملف DLL يمكنك التجريب على أي ملف لقد قمت بتجريب البرنامج على ملف أحد الاعضاء و النتيجة بالمرفقات الملف عبارة عن كود بسيط يبحث عن تكرار في عمودين و نقل المكرر الى عمود ثالث هدا الكود مثلا قبل استعمال برنامج vbacompiler for excel Sub brg() ScreenUpdating = False Dim lr As Integer Dim lr1 As Integer Dim c As Range lr1 = ActiveSheet.Range("g" & Rows.Count).End(xlUp).Row For Each c In ActiveSheet.Range("c2:c1000") lr = ActiveSheet.Range("i" & Rows.Count).End(xlUp).Row If WorksheetFunction.CountIf(ActiveSheet.Range("g2:g" & lr1), c.Value) >= 1 Then Cells(lr + 1, 9) = c.Value On Error Resume Next End If Next ScreenUpdating = True End Sub و هذا بعد استعمال البرنامج #If Win64 Then Private Declare PtrSafe Sub p0iflwmc269 Lib "EXEMPLE_xlsm_64.dll" Alias "r8rfyae98n05rlq" () #Else Private Declare Sub p0iflwmc269 Lib "EXEMPLE_xlsm_64.dll" Alias "r8rfyae98n05rlq@0" () #End If Sub brg() p0iflwmc269 End Sub Option Private Module #If Win64 Then Private Declare PtrSafe Function SetThisWbk Lib "EXEMPLE_xlsm_64.dll" Alias "SetThisWorkbook" (ByVal twbk As Object) As Long Private Declare PtrSafe Function u6hpyov9dx5 Lib "EXEMPLE_xlsm_64.dll" (ByVal i As Long, ByVal obj As Object) As Long Private Declare PtrSafe Function c1smc91ey1mls Lib "EXEMPLE_xlsm_64.dll" (ByVal i As Long, ByVal mp As LongPtr) As Long Private Declare PtrSafe Function s1a3nzo1yqora3l Lib "EXEMPLE_xlsm_64.dll" () As Variant Private Declare PtrSafe Sub d0np2x0oglsn Lib "EXEMPLE_xlsm_64.dll" (ByVal dst As Any, ByVal src As LongPtr, ByVal sz As Long) Private Declare PtrSafe Function p8t9c8qi9tgx Lib "EXEMPLE_xlsm_64.dll" (ByRef p() As Any) As LongPtr Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal libFileName As String) As LongPtr Private Declare PtrSafe Function FreeLibrary Lib "kernel32" (ByVal hLibModule As LongPtr) As LongLong Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr #Else Private Declare Function SetThisWbk Lib "EXEMPLE_xlsm_64.dll" Alias "SetThisWorkbook@4" (ByVal twbk As Object) As Long Private Declare Function u6hpyov9dx5 Lib "EXEMPLE_xlsm_64.dll" Alias "u6hpyov9dx5@8" (ByVal i As Long,ByVal obj As Object) As Long Private Declare Function c1smc91ey1mls Lib "EXEMPLE_xlsm_64.dll" Alias "c1smc91ey1mls@8" (ByVal i As Long,ByVal mp As Long) As Long Private Declare Function s1a3nzo1yqora3l Lib "EXEMPLE_xlsm_64.dll" Alias "s1a3nzo1yqora3l@0" () As Variant Private Declare Sub d0np2x0oglsn Lib "EXEMPLE_xlsm_64.dll" Alias "d0np2x0oglsn@12" (ByVal dst As Any,ByVal src As Long,ByVal sz As Long) Private Declare Function p8t9c8qi9tgx Lib "EXEMPLE_xlsm_64.dll" Alias "p8t9c8qi9tgx@4" (ByRef p() As Any) As Long Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal libFileName As String) As Long Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long #End If Private Function k7wgf46mba0cj8() As String On Error Resume Next k7wgf46mba0cj8 = ThisWorkbook.Path + "\EXEMPLE_xlsm_64.dll" End Function Public Sub p8oi75y3jrid8() #If Win64 Then Dim hModule As LongPtr Dim dllPath As String Dim msg As String On Error Resume Next dllPath = k7wgf46mba0cj8() hModule = LoadLibrary(dllPath) If hModule = 0 Then MsgBox "Cannot load '" & dllPath & "'" ThisWorkbook.Close False Else c1smc91ey1mls 1&, AddressOf u4fw2npwzdn25f4 If SetThisWbk(ThisWorkbook) Then u6hpyov9dx5 3&, Sheet1 u6hpyov9dx5 4&, Sheet2 u6hpyov9dx5 2&, ThisWorkbook ThisWorkbook.Saved = True Else GoTo qpnt End If End If #Else MsgBox "This workbook can work with 64 bit Excel only" ThisWorkbook.Close False #End If Exit Sub qpnt: ThisWorkbook.Close False End Sub Public Sub x1u5slqd9g() On Error GoTo errh SetThisWbk (ThisWorkbook) Exit Sub errh: p8oi75y3jrid8 End Sub Public Function q7uobay8mw() As Boolean On Error Resume Next q7uobay8mw = GetModuleHandle("EXEMPLE_xlsm_64.dll") <> 0& End Function #If Win64 Then Public Function FreeCompiledDll() As LongLong Dim i As Long Do FreeCompiledDll = FreeLibrary(GetModuleHandle("EXEMPLE_xlsm_64.dll")) i = i + 1 Loop While FreeCompiledDll <> 0 And i < 100 End Function #End If Private Sub auto_open() x1u5slqd9g End Sub Private Sub auto_close() #If Win64 Then On Error Resume Next Dim p As Variant ThisWorkbook.Saved = True SetThisWbk Nothing p = s1a3nzo1yqora3l FreeCompiledDll If p <> "" Then Kill p & "cbinrtl.dll" RmDir p End If #End If End Sub Function u4fw2npwzdn25f4(ByVal v7liriqd8 As Variant, ByVal m8g6onrhcrw As Variant, ByVal m7jy4oel As Variant, ByRef j8yhrsbf2() As Variant) As Variant On Error Resume Next Dim sz As Long sz = UBound(j8yhrsbf2) - LBound(j8yhrsbf2) + 1 Select Case sz Case 0 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel) Case 1 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0)) Case 2 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1)) Case 3 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2)) Case 4 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2), j8yhrsbf2(3)) Case 5 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2), j8yhrsbf2(3), j8yhrsbf2(4)) Case 6 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2), j8yhrsbf2(3), j8yhrsbf2(4), j8yhrsbf2(5)) Case 7 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2), j8yhrsbf2(3), j8yhrsbf2(4), j8yhrsbf2(5), j8yhrsbf2(6)) Case 8 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2), j8yhrsbf2(3), j8yhrsbf2(4), j8yhrsbf2(5), j8yhrsbf2(6), j8yhrsbf2(7)) Case 9 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2), j8yhrsbf2(3), j8yhrsbf2(4), j8yhrsbf2(5), j8yhrsbf2(6), j8yhrsbf2(7), j8yhrsbf2(8)) Case 10 u4fw2npwzdn25f4 = CallByName(v7liriqd8, m8g6onrhcrw, m7jy4oel, j8yhrsbf2(0), j8yhrsbf2(1), j8yhrsbf2(2), j8yhrsbf2(3), j8yhrsbf2(4), j8yhrsbf2(5), j8yhrsbf2(6), j8yhrsbf2(7), j8yhrsbf2(8), j8yhrsbf2(9)) End Select End Function و الملف يعمل بكفاءة جيدة يمكنكم التجربة من المرفقات ملف خاص بعد التشفير ب اوفيس 64 و ملف خاص بعد التشفير ب اوفيس 32 و السلام عليكم و تقبل الله منا و منكم الملف بدون تشفير.rar الملف مشفر مع ملف DLL لنسخة اوفيس 32.rar الملف مشفر مع ملف DLL لنسخة اوفيس 64.rar

وعليكم السلام هذا الموضوع مهم جدا