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

السلام عليكم 🙂 اذا عندنا تقرير بهذه الطريقة: . اليس الافضل دمج بيانات الحقل المتكررة عموديا في حقل واحد ، مثل الوورد مثلا الى : . طريقة العمل : 1. اعمل تقريرك بالطريقة اللي تراها مناسبة ، بالفرز والتصفية : . او بالمجاميع : . 2. ولكن قم بوضع جميع الحقول في قسم "التفصيل" Detail : . 3. ثم اجعل برواز جميع حقول هذا القسم شفافة . 4. ثم الحقول التي تريد دمجها ، اخفاء المتكرر = نعم ، Hide Duplicates = Yes . 5. ثم ضع هذه الاحداث للتقرير Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer) 'Border color not set, use field ForeColor Call Detail_Print_Run_All(5, "'اليوم', 'التاريخ','الزمن'") End Sub Private Sub Report_Open(Cancel As Integer) Call Report_Open_Run(Me.Name) End Sub Private Sub Report_Close() On Error Resume Next Set ctl_ReSize = Nothing End Sub Private Sub Report_Page() Call Report_Page_Run End Sub . 6. لا تحتاج الى عمل اي تغيير في الاحداث اعلاه ، فقط انسخها من هنا والصقها في تقريرك ، ما عدا اول جزء : عرض البرواز ، حيث نخبره باسماء الحقل/الحقول التي نريد دمجها عموديا ، لون البرواز يكون حسب اللون الذي نكتبه ، او اذا لم نكتب لون البرواز ، فلون البرواز سيكون لون نص الكلمات في الحقل . 7. نسخ الوحدة النمطية mod_Report_Field_Hieght_ReSize الى تقريرك ن وكذلك بدون عمل اي تغيير فيها : Option Compare Database Option Explicit Dim rpt_Name_ReSize As String Dim rgb_Border_ReSize As Long, ini_rgb_Border_ReSize As Long Dim Detail_Calc_Height_ReSize As Long Dim Exclude_fld_Name_ReSize As String Dim Add_H_Each_Record_ReSize As Boolean Dim fildMaxHeight_ReSize As Long Dim myDrawWidth As Integer Public ctl_ReSize As Control Dim i_ReSize As Integer, j_ReSize As Integer Dim x_ReSize() As String, tmp_ReSize As String Dim Count_Pages_ReSize As Integer Dim sfld_Name_ReSize() As String, sfld_Value_ReSize() As String, _ sfld_Count_ReSize() As Integer Dim L_ReSize As Single, T_ReSize As Single, W_ReSize As Single, H_ReSize As Single ' Function Detail_Print_Run_All(LineWidth As Integer, myFields As String, Optional border_Color As Long = 1) 'we can this Function in the following ways, indicating Border Color 'Call Detail_Print_Run_All(5, "'c1', 'save', 'b1'", RGB(0, 0, 0)) 'Border color is RGB Value 'Call Detail_Print_Run_All(5, "'c1', 'save', 'b1'", vbBlack) 'Border color is Black 'Call Detail_Print_Run_All(5,"'c1', 'save', 'b1'", vbMagenta) 'Border color is Magenta 'Call Detail_Print_Run_All(5,"'c1', 'save', 'b1'") 'Border color not set, use field ForeColor 'Call Detail_Print_Run_All(5,"'b1'", RGB(0, 0, 0)) '5 is Line Width 'we get most the Lines drawn in Detail Section, 'except for the Last Record in each page, where we use Report Page event (the last page is easy) ini_rgb_Border_ReSize = border_Color rgb_Border_ReSize = ini_rgb_Border_ReSize Exclude_fld_Name_ReSize = myFields Add_H_Each_Record_ReSize = False myDrawWidth = LineWidth 'make an array of the fields x_ReSize = Split(Exclude_fld_Name_ReSize, ",") ReDim Preserve sfld_Name_ReSize(UBound(x_ReSize)) ReDim Preserve sfld_Value_ReSize(UBound(x_ReSize)) ReDim Preserve sfld_Count_ReSize(UBound(x_ReSize)) '1 'do the Detail Lines for the remaining fields Call Detail_Sec_Max_Height '2 'now work on the special fields Lines For i_ReSize = 0 To UBound(x_ReSize) 'remove the ' , and the extra spaces from the Left and Right tmp_ReSize = RTrim(LTrim(Replace(x_ReSize(i_ReSize), "'", ""))) sfld_Name_ReSize(i_ReSize) = tmp_ReSize Call Scale_Box_Lines(tmp_ReSize) Next i_ReSize End Function Function Report_Open_Run(rpt_Name_ReSize_1) rpt_Name_ReSize = rpt_Name_ReSize_1 'Reset the variables from here Count_Pages_ReSize = 0 Erase sfld_Name_ReSize Erase sfld_Value_ReSize Erase sfld_Count_ReSize Detail_Calc_Height_ReSize = 0 End Function Function Report_Page_Run() 'make an array of the fields x_ReSize = Split(Exclude_fld_Name_ReSize, ",") 'now work on the special fields Lines For j_ReSize = 0 To UBound(x_ReSize) 'remove the ' , and the extra spaces from the Left and Right tmp_ReSize = RTrim(LTrim(Replace(x_ReSize(j_ReSize), "'", ""))) sfld_Name_ReSize(j_ReSize) = tmp_ReSize Set ctl_ReSize = Reports(rpt_Name_ReSize)(tmp_ReSize) If ini_rgb_Border_ReSize = 1 Then rgb_Border_ReSize = ctl_ReSize.ForeColor End If 'make it simple to understand L_ReSize = ctl_ReSize.Left W_ReSize = ctl_ReSize.Width T_ReSize = ctl_ReSize.Top 'H_ReSize = ctl_ReSize.Height 'we have to add the Sections/Fields ABOVE the Detail Section If Reports(rpt_Name_ReSize).Page = 1 Then H_ReSize = Detail_Calc_Height_ReSize + _ Reports(rpt_Name_ReSize).PageHeaderSection.Height + _ Reports(rpt_Name_ReSize).ReportHeader.Height Else H_ReSize = Detail_Calc_Height_ReSize + _ Reports(rpt_Name_ReSize).PageHeaderSection.Height End If Reports(rpt_Name_ReSize).DrawWidth = myDrawWidth Reports(rpt_Name_ReSize).Line (L_ReSize, T_ReSize + H_ReSize)-(L_ReSize + W_ReSize, T_ReSize + H_ReSize), rgb_Border_ReSize 'Bottom Line Next j_ReSize Detail_Calc_Height_ReSize = 0 End Function Public Function Scale_Box_Lines(fld_Name As String) Set ctl_ReSize = Reports(rpt_Name_ReSize)(fld_Name) 'make it simple to understand L_ReSize = ctl_ReSize.Left W_ReSize = ctl_ReSize.Width T_ReSize = ctl_ReSize.Top H_ReSize = ctl_ReSize.Height If ini_rgb_Border_ReSize = 1 Then rgb_Border_ReSize = ctl_ReSize.ForeColor End If 'take the highst Height If fildMaxHeight_ReSize > H_ReSize Then H_ReSize = fildMaxHeight_ReSize End If If ctl_ReSize.Text <> sfld_Value_ReSize(i_ReSize) Then sfld_Value_ReSize(i_ReSize) = ctl_ReSize.Text sfld_Count_ReSize(i_ReSize) = 1 End If 'Box the cells 'Left and Right ctl_ReSize.BorderColor = vbWhite Reports(rpt_Name_ReSize).DrawWidth = myDrawWidth Reports(rpt_Name_ReSize).Line (L_ReSize, T_ReSize)-(L_ReSize, H_ReSize), rgb_Border_ReSize 'Left Line Reports(rpt_Name_ReSize).Line (L_ReSize + W_ReSize, T_ReSize)-(L_ReSize + W_ReSize, H_ReSize), rgb_Border_ReSize 'Right Line 'Top and Bottom If Reports(rpt_Name_ReSize).Page <> Count_Pages_ReSize Then 'first Count_Pages_ReSize = Count_Pages_ReSize + 1 Reports(rpt_Name_ReSize).Line (L_ReSize, T_ReSize)-(L_ReSize + W_ReSize, T_ReSize), rgb_Border_ReSize 'Top Line ElseIf sfld_Count_ReSize(i_ReSize) = 1 Then 'First Record Reports(rpt_Name_ReSize).Line (L_ReSize, T_ReSize)-(L_ReSize + W_ReSize, T_ReSize), rgb_Border_ReSize 'Top Line End If sfld_Count_ReSize(i_ReSize) = sfld_Count_ReSize(i_ReSize) + 1 End Function Public Function Detail_Sec_Max_Height() fildMaxHeight_ReSize = 0 'get the max Height For Each ctl_ReSize In Reports(rpt_Name_ReSize).Section(0).Controls If ctl_ReSize.Height > fildMaxHeight_ReSize Then fildMaxHeight_ReSize = ctl_ReSize.Height End If Next 'Draw lines around the fields For Each ctl_ReSize In Reports(rpt_Name_ReSize).Section(0).Controls If InStr(Exclude_fld_Name_ReSize, "'" & ctl_ReSize.Name & "'") = 0 Then Reports(rpt_Name_ReSize).DrawWidth = myDrawWidth Reports(rpt_Name_ReSize).Line (ctl_ReSize.Left, ctl_ReSize.Top)-Step(ctl_ReSize.Width, fildMaxHeight_ReSize), ctl_ReSize.ForeColor, B 'just add the Heighs of ONE Record If Add_H_Each_Record_ReSize = False Then Detail_Calc_Height_ReSize = Detail_Calc_Height_ReSize + fildMaxHeight_ReSize Add_H_Each_Record_ReSize = True End If End If Next End Function . 8. ما عدا هذا الجزء ، والذي يجب ان نضع فيه اسماء جميع الاقسام التي فوق "قسم التفصيل" ، والتي بها ارتفاع : . من هنا نعرف اسم هذه الاقسام : . وهذه نتائج بعض التقارير التي تم النجربة عليها : . . . . ولم اتوصل لطريقة لجعل الكلمات في منتصف الحقل عموديا ، هكذا: جعفر Report_BoxLine_07.accdb.zip

الخطوة الثانية تم التخلص من فتح التقرير مرتين وجاري العمل على الخطوة الثالثة. DrawLines_02.accdb

نعم كان مرهق ، واوقفت تقريبا جميع اعمالي بس علشان اكمله !! اذا الله سبحانه وتعالى قدّرني ، بكرة ان شاء الله اكتب تفاصيل العمل 🙂 محاولاتي الاولى فشلت 😞 اتمنى ابو احمد يقدر يضيف هذه الفقرة في برنامجه ان شاء الله 🙂 جعفر

مما لاحظته أن دالة التشفير الأخيرة ناقصة غير مكتملة .. وأما الأخريات جربتها وهي تعمل تمام التمام 🙂 ثم طلبت منه أن يكملها 😅 فأعطاني : ' Function to decrypt a string using the CryptoAPI Function DecryptString(CipherText As String) As String Dim Data() As Byte Dim PlainText() As Byte Dim DataLen As Long Dim PlainTextLen As Long Dim hCryptProv As Long Dim hKey As Long Dim AlgID As Long ' Convert the cipher text string to a byte array Data = StrConv(CipherText, vbFromUnicode) DataLen = UBound(Data) + 1 ' Set the encryption algorithm and key size AlgID = CALG_RC4 hKey = 0 ' Get a handle to the default encryption provider If CryptAcquireContext(hCryptProv, vbNullString, vbNullString, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) Then ' Generate a random session key If CryptGenKey(hCryptProv, AlgID, KEYLEN_256, hKey) Then ' Allocate a buffer for the plain text ReDim PlainText(DataLen) PlainTextLen = DataLen ' Decrypt the data If CryptDecrypt(hKey, 0, True, 0, PlainText(0), PlainTextLen) Then ' Convert the plain text to a string and return it DecryptString = StrConv(PlainText, vbUnicode) End If End If End If ' Release the encryption provider and key handles If hKey Then CryptDestroyKey hKey If hCryptProv Then CryptReleaseContext hCryptProv, 0 End Function

نعم اخي جعفر عدنا الى بداية الثمانينات والشاشة السوداء على كل حال الطريقة باستخدام شرطين اذا كان الباسورد صحيح اذهب الى a وفيها الشرط الثاني الخاص بالاخفاء والاظهار تاكد من وجود الملف بامتداد اكسس في المسار ثم غير الامتداد الى txt او اي امتداد نرغب ثم اخفي المجلد اما اذا كان الامتداد في المجلد ليس اكسس غيره الى اكسس واظهر المجلد اخيرا اذا كان الباس غير صحيح اذهب الى k وفي اجراء k رسالة ان الباس غير صحيح واغلق الباتش هذا كل شي @echo off set /p pass="Enter your password:" if %pass%==1980 (goto a) else goto k :a if exist d:\folders\myfolder\"kh.accdb" ( ren d:\folders\myfolder\*.accdb *.txt attrib +s +h d:\folders\myfolder goto end ) else ( attrib -s -h d:\folders\myfolder ren d:\folders\myfolder\*.txt *.accdb goto end ) :k echo invalid password pause goto end ) :end فقط افتح برنامج المفكرة ثم احفظ الكود بامتداد bat ولا تنسي تغيير مسار المجلد الى المسار لديك وايضا الرقم السري اخيرا مازالت عند رأيي السابق فكر فيما اشار عليك الاستاذ جعفر ودع عنك الباتشات فانا اشرت اليها على انها حل اخر و من زمن اخر ، فقط لاثراء الموضوع وليس بديلا لما اشار اليه الاساتذه الكرام تحياتي

بداية اعتذر عن التأخير لاسباب خاصة الحقيقة ان الحل المقدم من الاستاذ @jjafferr في رأيي هو الحل الامثل بالنسبة لملف الباتش ممكن عمله وان كنت افضل دائما تجنب ذلك طالما توجد حلول اخرى بداية ممكن كتابة الباتش بطرق كثيرة وجميعها تؤدي العرض الطريقة الاولى ⬇️ اذا كانت كلمة المرور صحيحة اظهر الملف وغير ذلك انهي الباتش @echo off set /p pass="Enter your password:" if %pass%==1980 ( attrib -s -h d:\folders\myfolder goto end ) else ( echo invalid password pause goto end ) :end الطريقة الثانية ⬇️ اذا كان الباس صحيح اذهب الى A وغير صحيح اذهب الى K ولكل منهما اجراء @echo off set /p pass="Enter your password:" if %pass%==1980 (goto a) else goto k :a attrib -s -h d:\folders\myfolder goto end :k echo invalid password pause goto end :end الطريقة الثالثة ⬇️ باستخدام نفي الشرط @echo off set /p pass="Enter your password:" if not %pass%==1980 goto k attrib -s -h d:\folders\myfolder goto end :k echo invalid password pause goto end :end ممكن تغيير الرقم السري من 1980 الى اي رقم تريده ايضا تغيير مسار الملف حسب مسار البرنامج لديك ممكن ايضا تنفيذ الملف من خلال زر امر او حدث في اكسس ممكن ايضا تحويل الملف الدفعي الى ملف تنفيذي exe ولحفظ الملف انسخه في المفكرة ثم احفظ بامتداد bat ممكن ايضا اخفاء ملف الباتش وتنفيذه من خلال ملف باتش اخر هذا فيما يتعلق باظهار المجلد واذا اردنا عكس العملية باخفاء المجلد ممكن استبدال attrib -s -h d:\folders\myfolder الى attrib +s +h d:\folders\myfolder واذا اردنا مزيد من التموية ممكن نضع امر تغيير مسمى البرنامح وامتدادة مثلا ren d:\folders\myfolder\kha.accdb test.ini attrib +s +h d:\folders\myfolder ولكن اذا استخدام تغيير الاسم والامتداد لابد ان نعيدهما بنفس الطريق في باتش اظهار الملف اخير ممكن وضع شرط في الباتش اذا كان الملف مخفي اظهره وان كان ظاهرا اخفيه ولكني سأكتفي بما سبق تحياتي

وعليكم السلام ورحمة الله وبركاته ارجو ان يكون الحل فيه طلبك ترحيل البيانات نصفين متساويين.xlsm

كما العنوان ، رسم Lines و Borders/Frames لتقارير الأكسس ، نسخة أولى تجريبية أنا مجهد وسأعود الليلة أو غدا للكتابة عن بعض التفاصيل وحيثيات التصميم والعراك مع برمجة المثال. اكتبوا ملاحظاتكم وطلب خاص مني وبشكل مؤقت ، لا ترفعوا نسخا معدلة ، فقط ضعوا ملاحظاتكم. وشكرا لكم. من ميزات المثال: أنه لا يجبر المبرمج على استخدام الرسم على كل حقول التقرير. أنه يتعامل مع عرض الخط/الإطار حسب الخصائص. أنه يتعامل مع لون الخط/الإطار حسب الخصائص. ومن عيوبه: قد يكون بطيئا عند كثرة البيانات وعدد الصفحات لفتح التقرير مرتين لزوم الحصول على بعض بيانات النسيق. عندي أفكار أخرى سأؤجلها حتى أرى مثال الأخ العزيز جعفر فقد أكتفي أو أقوم ببعض التحسينات بالاستفادة من مثاله. ملاحظات: العمل في هذا المثال أضافت إلي معلومات جديدة لأول مرة وهذا طبيعي فلم تكن لي حاجة بها قبل هذا المثال. DrawLinesAndBoxes4AccessReports_01.accdb

أهلا بك أخي @nssj 🙂 بداية أشكر أخي @محب العقيدة على الموقع الرائع الذي أشار إليه في هذا الموضوع : اداة بحث ثورية 😊🌹 وقد طلبت من الموقع أن يعطيني كود يستخرج الأرقام ( فقط ) من بين هذه الأقواس {} .. من أي جملة .. وقد أعطاني هذا الكود ( قمت بعمل بعض التعديلات البسيطة وتحويله إلى دالة 🙂 ) : Public Function ExtractNumbers(text As String) As String ' This Code extract only numbers from a text if they are surrounded by these characters "{}" Dim i As Integer Dim num As String Dim result As String 'text = "The value of x is {3} and the value of y is {7}" result = "" For i = 1 To Len(text) If Mid(text, i, 1) = "{" Then ' Found the start of a number num = "" Do While Mid(text, i, 1) <> "}" ' Check if the current character is a numeric character If IsNumeric(Mid(text, i, 1)) Then num = num & Mid(text, i, 1) End If i = i + 1 Loop ' Found the end of the number, so add it to the result result = result & num & " " End If Next ' result now contains the numbers from the text, separated by spaces 'Debug.Print result ExtractNumbers = Trim(result) End Function والنتيجة رهييييييييييبة بصراحة ونااااااااااااجحة 100% 😄👌🏼 مثال بعد التطبيق : وهذه الجزئية لم أفهمها في طلبك .. 🙂 MZ_MNO.rar

من رأيي واحد من افضل البرامج لكن في البداية افتح ملف فارغ واحفظ بصيغة bat تجد بعد ذلك انه بمجرد كتابة الحرف الاول يقدم اقتراحات للاوامر الشائعة لهذا النوع اضافة الى سهولة تتبع الاخطاء وتظليل الكلمات المكررة الخ وفي النهاية لكل رأيه 🌹 لا علم لدي تحياتي بالتوفيق د.محمد

شكرا لك أخي محب العقيدة 🙂 فعلا موقع رهيييييييييييييييب جدا جدا .. جربته وهذه بعض النتائج : (1)----------------------------------------------------------------------------- سألته أن يكتب لي كود يولد نص عشوائي مختلط حروف ورموز وأرقام ، فأعطاني هذا : Function GenerateRandomString(Length As Integer) As String Dim i As Integer Dim RandomChar As String Dim RandomString As String Randomize For i = 1 To Length ' Generate a random number between 48 and 122 (ASCII values for 0-9, a-z, and A-Z) RandomChar = Chr(Int((122 - 48 + 1) * Rnd + 48)) RandomString = RandomString & RandomChar Next i GenerateRandomString = RandomString End Function وتناديه هكذا : Dim RandomString As String RandomString = GenerateRandomString(8) (2)----------------------------------------------------------------------------- سألته أن يكتب لي كود يعطيني رقم عشوائي بين رقمين .. فأعطاني هذا : RandomNumber = Int((UpperBound - LowerBound + 1) * Rnd + LowerBound) أو Dim RandomNumber As Integer Randomize RandomNumber = Int((10 - 1 + 1) * Rnd + 1) (3)----------------------------------------------------------------------------- سألته أن يكتب لي كود يقوم بتشفير النصوص وكود آخر لفك الشيفرة فأعطاني هذا : ' Function to encrypt a string using the CryptoAPI Function EncryptString(PlainText As String) As String Dim Data() As Byte Dim CipherText() As Byte Dim DataLen As Long Dim CipherTextLen As Long Dim hCryptProv As Long Dim hKey As Long Dim AlgID As Long ' Convert the plain text string to a byte array Data = StrConv(PlainText, vbFromUnicode) DataLen = UBound(Data) + 1 ' Set the encryption algorithm and key size AlgID = CALG_RC4 hKey = 0 ' Get a handle to the default encryption provider If CryptAcquireContext(hCryptProv, vbNullString, vbNullString, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) Then ' Generate a random session key If CryptGenKey(hCryptProv, AlgID, KEYLEN_256, hKey) Then ' Allocate a buffer for the cipher text ReDim CipherText(DataLen) CipherTextLen = DataLen ' Encrypt the data If CryptEncrypt(hKey, 0, True, 0, CipherText(0), CipherTextLen, DataLen) Then ' Convert the cipher text to a string and return it EncryptString = StrConv(CipherText, vbUnicode) End If End If End If ' Release the encryption provider and key handles If hKey Then CryptDestroyKey hKey If hCryptProv Then CryptReleaseContext hCryptProv, 0 End Function ' Function to decrypt a string using the CryptoAPI Function DecryptString(CipherText As String) As String Dim Data() As Byte Dim PlainText() As Byte Dim DataLen As Long Dim PlainTextLen As Long Dim hCryptProv As Long Dim hKey As Long Dim AlgID As Long ' Convert the cipher text string to a byte array Data = StrConv(CipherText, vbFromUnicode) DataLen = UBound(Data) + 1 ' Set the encryption algorithm and key size AlgID = CALG_RC4 hKey = 0 ' Get a handle to the default encryption provider If CryptAcquireContext(hCryptProv, vbNullString, vbNullString, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) Then ' Generate a random session key If CryptGenKey(hCryptProv, AlgID, KEYLEN_256, hKey) Then ' Allocate a buffer for the plain text ReDim PlainText(DataLen) PlainTextLen = DataLen ' Decrypt the data If CryptDecrypt(hKey, 0

البرنامج جميل وسريع 🙂 جعفر

تقصد الملفات المصابة او المشبوهة ؟ تجربتي قديمة على ملفات غير مشروعة في ويندوز اكس بي وويندوز 7 لا يتم اكتشاف هذا النوع الا اذا تم عمل فحص شامل للهارد او اذا قام الملف باجراء مشبوه وبشرط ان يكون مكافح الفيروسات محدث ونسخة نظام التشغيل اصليه غير معدلة ومحدثة اما اصحاب النسخ المكركة فلا تعليق بالنسبة للاصدار 10 و 11 فلا علم لدى فقد توقف عن تجريب مثل هذه البرامج اذا كان فهمي صحيح فممكن عمل باتش يقوم بنقل ملف البرنامج الى مكان اخر وضغطة باستخدام الوين رار ويكون ناتج الملف على شكل صورة صيغة امر الدمج copy /b 11.jpg+kha.rar new.jpg وبالتالي يكون لديك ملف صورة بريئة كأي صورة اخرى ولكن من يدقق سيجد ان حجمها اكبر من المعتاد وفي جميع الاحوال سأتوقف هنا فقد ادركنا الصباح افضل برنامج لكتابة اكواد الباتش Notepad++ تحياتي

موفق لعون الله

السلام عليكم 🙂 الحمدلله انتهيت من المشروع ، وهذا رابطه جعفر

سبحان الله ، نرجع الى اصل الوندوز ، الدوز DOS 🙂 شكرا جزيلا لك اخوي خالد 🙂 جعفر

الن يسعد مساءك بالخير المكتيات موجودة وتم اصلاخ الخلل واعتقد انك تعمل على اوفس 14 وبكل صراحة هذا ماكنت ابخث عنة من فترة والخمد لله الذي اتى بة لي ولك جزيل الشكر والشكر للاخ جعفر ابو المقالب ((مداعبة)) 🤣🤣

السلام عليكم ورحمة الله يمكنك استخدام الكود التالى Sub JnQuran() Dim ws As Worksheet, LR As Long Dim Arr(), Tmp, Tgrt As String, Reslt As String Dim i As Long, j As Long, p As Long Set ws = Sheets("حفص") LR = ws.Range("E" & Rows.Count).End(3).Row Tgrt = ws.Range("L17") Arr = ws.Range("C2:E" & LR).Value ReDim Tmp(1 To UBound(Arr, 1), 1 To UBound(Arr, 1)) For i = 1 To UBound(Arr, 1) If Arr(i, 3) = Tgrt Then p = p + 1 Tmp(p, 1) = Arr(i, 2) & Arr(i, 1) Reslt = Reslt & "" & Tmp(p, 1) End If Next ws.Range("I3") = Reslt End Sub

السلام عليكم ورحمة الله تعالى وبركاته اولا : كل الشكر لكل اساتذتى الكرام الذين ادلو بدلوهم وشاركوا معلوماتهم فى هذا الموضوع ثانيا: وتلبية لدعوة الدكتور @الحلبي لمشاركة افكارى المتواضعة سوف اقوم بعمل موضوع مستقل واتيكم بالرابط اصبر وابشر وانتظر

السلام عليكم تم تعديل المرفق كالتالي 1- تعطيل عمل الزر .. 2- تطبيق مطلوبك على مربع السرد النصف الاول بمعنى انه سوف يتم ارسال التقرير حسب الاسم في مربع السرد يمكنك اكمال العملية وارى انك تجمع تقاريرك كلها في مربع تحرير واحد ويكون الفرق في تسمية التقارير مثلا : دراسات1 ، دراسات2 وهكذا ... تجربة2.rar

أعتقد أن الأخ فؤاد يقصد أن تكون هناك نسختان من الجداول : جداجداول محلية وجداول مرتبطة بالقاعدة الأخرى ( الاحتياطية ) .. فما يتم تسجيله في الجداول المحلية يتم نسخه تلقائيا في الجداول المرتبطة ..

اعرض الملف 0000 2022 سجل الاصول الثابتة + جدول الاحتساب تقرير الاهلاك السنوي والشهري مفصل، و تقرير اجمالي حسب دليل حسابات المنشأة، محضر جرد ومطابقة الأصول، نموذج استلام اصل، و نموذج استبعاد اصل (قرار التخلص من اصل). صاحب الملف salahmosaed تمت الاضافه 13 ديس, 2022 الاقسام قسم الإكسيل  

بسم الله الرحمن الرحمن الرحيم الدرس الثاني لليوزفورم التفاعلي تعال نفكر مع بعض خارج المألوف والمعقول بمعني ايه اي حد بفكر يعمل فورم يسهل استخدام البيانات بقعد يفكر في شكل الفورم وتصميمه وتركيب الاكواد وما الي ذلك في موضوعات تناولت الفورم المرن او حسب مايكون اسمه فورم بيركب علي ورقة العمل وتضبط شغلك عليه لو فكرنا بطريقة مختلغة برمجية خارج حدود التصميم والاكواد والوقت والمجهود طيب الفكرة هنا ايه ...........!!! فورم يصنع لك الفورم يلي انت عاوزه بالالوان والاعمدة والشكل نفس فكرة مواقع التصميم والبلوجر يلي بتعطيك template قالب جاهز وتعدل عليه ندخل في الموضوع النهاردة موضوعنا فورم تفاعلي يصنع لك فورم خدمي نضيف ورقة عمل جديد من خلال التبويب Insert Sheet نضيف عدد الاعمدة يلي انت عاوزها في قاعدة بياناتك من خلال Enter No of columan مثال اضافة ورقة عمل جديدة باسم Officana عدد الاعمدة 5 مثلا (Sno-Name-username-password-Contact) اقوم بادخال اسماء الاعمدة ثم Add من خلال الفورم هاتقدر تعدل المسيات تضيف تحذف كما تشاء بعد ما تنتهي من الاعداد للتصميم لقاعدة بيانات كل يلي عليك تختار الشيت تدخل طريق العرض من خلال عدد الاعمد مثلا 3 وتضغط openForm وشوف النتيجة وهنا هتلاقي وظايف البحث والتعديل والحذف كما اخترت طريقة العرض 3 طيب لو غيرنا طريق العرض 2 لاحظ تغير الفورم معاك لتغير اللون اضغط علي Color هاسيبك تجرب بنفسك وتشوف النتيجة اتمني من الله اكون قدرت اوصلك المعلومة وافيدك الملف بالمرفقات Advance Data Entry Software Officana.xlsm الدرس القادم الفورم التفاعلي المتقدم عن نقاط البيع ان شاء الله برنامج POS لادارة نقاط البيع مع فاتورة ضريبية

شكرا جزيلا اخواني حصلت الطريقة وتفضلوا المرفق الجديد zaMove&CopyFiles&folders.mdb

تفضل ................... Mahdi119.rar

السؤال واضح وضوح الشمس في النهار اسمح لي اخوي لوكان ردي يزعلك : ردك اعلاه ما فهمت منه شي ، هل انت عربي ؟؟ اذا انت لست عربيا عذرناك

وعليكم السلام أخي طارق 🙂 تم عمل المجاميع عن طريق الاستعلام "مجاميع" طبعا يتم تحديث المجموع بناءا على الفرز المبني على القوائم المنسدلة الثلاثة .. وكذلك التي عليها علامة صح كما هو موضح وفي حال أن القوائم المنسدلة فارغة فإنه يأتي بمجموع جميع النتائج الظاهرة جمع المبالغ التي امامها علامة صح.rar

بل يعمل يا د. محمد ولكن قبل ذلك نوضح الاتي خاصية منبثق نعم مشروط لا " يعمل الكود بدون مشكله " ------ منبثق نعم مشروط نعم " لن يعمل الكود " لكون الخاصية مشروط تعني تعطيل اي نافذة اخرى الى ان تغلق النموذج المشروط اخيرا اذا كنا نرغب في منبثق نعم ومشروط نعم ويعمل الكود هنا يتطلب الامر ان نعطل خاصية مشروط عند تنفيذ الامر فقط لذا ممكن وضع الامر التالي في بداية الكود لزر الامر Dim k As Boolean: Forms("form1").Modal = False ليصبح الكود ⬇️ Dim k As Boolean: Forms("form1").Modal = False keybd_event 91, 0, 0, 0 keybd_event 77, 0, 0, 0 DoEvents keybd_event 91, 0, KEYEVENTF_KEYUP, 0 keybd_event 77, 0, KEYEVENTF_KEYUP, 0 DoEvents تحياتي الملف مرفق مع الشكر للاستاذة لميا WIn+M_Lamyaa(1).accdb

السلام عليكم ورحمة الله المصنف1.rar

بارك الله فيك استاذ سليم والله عندك حق وبعد اذنك -تفضل اخى ابو اياد ... هذا البرنامج الممتاز ولكن عليك بتوليفه لطلباتك فلا أحد يمتلك الوقت لتلبية كل طلباتك كما أوضح لك استاذنا الكبير سليم حاصبيا سلفاً كلمة المرور لدخول البرنامج : لا اله الا الله برنامج مبيعات ومشتريات مجاني كلمة السر لا اله الا الله.xlsm

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

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