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

ويمكنك استخدام السطر التالي لتحديث جميع الحقول 🙂 : CurrentDb.Execute "UPDATE TableName SET FieldName = 'النص المراد إضافته' "

السلام عليكم اساتذتى وزملائى الكرام مرفق الى حضرتكم برنامج لادارة الموارد البشرية للاسف انا لا اجيد كتابة المواضيع (سامحوني على هذا) لكن احب اولا ان اشكر كل من قدم لى المساعدة والنصح والارشاد حتى يخرج البرنامج بهذا الشكل خاصة استاذى الجليل @jjafferr وايضا @ابو جودي وايضا @Eng.Qassim @Moosak @ابوخليل والكثير من الاستاذة الاجلاء حفظهم الله لا استطيع ان اتذكرهم الان سائل المولى عز وجل ان يزيدهم من علمهم ويبارك فى صحتهم هم وزويهم واصحابهم وجميع المسلمين ناتي للبرنامج البرنامج فيه الكثير من الامور التى يصعب علي تسجيلها كلها هنا مثل نظام صلاحية المستخدمين (هو موجود لكن هناك الكثير من النماذج لم اقم باضافتها لاني انا المستخدم الوحيد للبرنامج فتكاسلت عن ظبطها لجميع النماذج) ايضا 1- تسجيل بيانات الموظفين (بيانات كاملة وشامله لاغلب ما يمكن ان يتطلب* 2-نظام الحضور والانصراف للموظفين وترحيلها 3-نظام تحضير وتجهيز الرواتب 4- طباعة ورقة الحضور للموظفين اليومي ....... الكثير الكثير من الاستعلامات الخاصه مثل الاستعلام عن حضور وانصراف و اضافى الموظفين و البحث عن الموظفين والتسجيل لهم غياب مرضى او اجازة عمرة او حج ..... الخ سوف اضع بعض الصور للبرنامج وقوائهم قائمة التكوين والاعدادات قائمة الاجراءات قائمة الاستعلامات هذا كل ما يمكن ان اذكره والباقى على المحتاجين للبرنامج استكشاف البرنامج والادوات الموجودة فيه ملاحظه : قمت بازالة لوجو الشركة عندي كل ما عليك وضع شعار الشركة او المؤسسة عندك فى التقارير ايضا (اكيد هيكون هناك بعض الاخطأ فى البرنامج لم اقم باصلاحها لانى توقفت عن استخدام البرنامج من فتره طوووويله ^_^ بسبب وجود جهاز للبصمه وتم الاستغناء عن نظام الحضور والانصراف فى البرنامج لكن باقى الامور ان شاء الله تعمل جيدا واذا كان هناك اى اصلاحات مطلوبه واستطيع ان اصلحها انا فى الخدمه واذا لم يكن فى امكاني فسوف اطلب المساعدة من اساتذتى الكرام حفظهم الله) كل ما احتاجه منكم دعوة لى فى ظهر الغيب ولاهلى وان تدعو لامي ان يغفر لها ويرحمها 😢 ولكم جزيل الشكر والعرفان . HR-OmarDahy.rar Key.rar

تم بحمد الله 🙂 يمكنك الآن استخراج جميع الأرقام من جميع السجلات وإضافتها في الجدول بضغطة زر واحدة ( الزر الأصفر في الأسفل ) 🙂 وأضفت النموذج الفرعي لرؤية الأرقام المرتبطة بالسجل .. وهذه السجلات في الجدول : MZ_MNO.rar

أهلا بك أخي @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

السلام عليكم و رحمة الله ضع الكود التالى فى موديول ثم اربط الكود بكل زر يحمل اسم ورقة معينة بشرط ان يتفق اسم الورقة مع الاسم المكتوب على الزر تماما Sub OpenSheet() Dim x As String On Error Resume Next x = ActiveSheet.Buttons(Application.Caller).Caption Sheets(x).Visible = xlSheetVisible Sheets(x).Select End Sub

بالجيميل 🙂

مما لاحظته أن دالة التشفير الأخيرة ناقصة غير مكتملة .. وأما الأخريات جربتها وهي تعمل تمام التمام 🙂 ثم طلبت منه أن يكملها 😅 فأعطاني : ' 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

شكرا لك أخي محب العقيدة 🙂 فعلا موقع رهيييييييييييييييب جدا جدا .. جربته وهذه بعض النتائج : (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

وعليكم السلام انسخ هذا الفكشن في موديول Function updateMyField() As Boolean Dim rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset("Table1") If rs.RecordCount > 0 Then rs.MoveFirst Do Until rs.EOF If Nz(rs!Field1, "") = "" Then rs.Edit rs!Field1 = "اوفيسنا" rs.Update End If rs.MoveNext Loop End If Set rs = Nothing updateMyField = True End Function Table1 اسم الجدول Field1 اسم الحقل الجديد في الجدول "اوفيسنا" ..النص الذي تريد نسخه ثم تقوم بأستدعاء الدالة من زر في النموذج هكذا call updateMyField

السلام عليكم 🙂 اذا عندنا تقرير بهذه الطريقة: . اليس الافضل دمج بيانات الحقل المتكررة عموديا في حقل واحد ، مثل الوورد مثلا الى : . طريقة العمل : 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

برنامج أرشفة 1- الملفات والمرفقات والمجلدات 2- البرامج المساعدة ومرفقاتها أرجو ابداء رأيكم به ArchiveMyFiles-Folders.rar

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

https://drive.google.com/file/d/16wPjc1F9pyCAZLQN7Ap3qcUOKOZ8bBMa/view?usp=drivesdk البرنامج مضغوط في ملف للتحميل من الرابط ويوضع في قرص D رمز المرور 1 التنزيل من درايف draiv

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

جزاك الله خيراً أخي الكريم Moosak وأحسن إليك .. تم المطلوب بحمد الله بعد تجاوز بعض المشاكل وتصحيح بعض الأخطاء في الملف .. ولذلك تأخرت في الرد 🙂 أولا: غيرت (Dim I As Integer) إلى (Dim I As Long) للعمل على الملف الأصلي الذي يحتوي (54700) سجلا ثانيا: كانت تخرج هذه الرسالة وكنت أظن أن المشكلة هي كثرة عدد السجلات، فكنت أحذف من السجلات وأعيد التجربة حتى وصلت إلى (70) سجلاً، ولا زالت الرسالة تخرج وبعدين شربت كاسة شاي ومخمخمت 😁 واستنتجت أن المشكلة هي وجود قوس البداية { ، بدون نهايته: } ، ويرجع السبب لأمرين: 1- أنني استخدمت نصا مختصرا، لأني لا أريد البحث في كل السجل لوجود أرقام بين {} في أواخر العديد من السجلات وهي أرقام غير مطلوب استخراجها، نحو: (يأتي {8155} ، تقدم {122} ..) وفي بعض الصفوف كانت توجد آيات بين قوسين {} ونتيجة الاختصار تبقى بداية الآيات مع قوس البداية { ، ويحذف الباقي مع قوس النهاية } وتجاوزت هذه المشكلة بعمليات استبدال {أ - {ب - {ت .. .. بفراغ 2- وجود أخطاء بكتابة الأرقام والأقواس، مثل: {1088) ، {2512 عن ابن .. وتم تصحيح هذه الأخطاء، لأن الكود يقوم بتعبئة الجدول إلى أن يصل إلى السجل الذي فيه الخطأ ويقف، وهكذا عرفت أين الأخطاء وعالجتها والآن بحمد الله تم المطلوب وزيادة: بتصحيح هذه الأخطاء فالحمد لله أولاً وآخراً وكل الشكر للأخ الكريم Moosak على مساعدته

هلا بيك اكثر لابأس استخدم عرض التصميم Database30.rar

وعليكم السلام.. اجعل النموذج في وضع layout view ثم اضغط على العنصر الموجود في النموذج ومن الشريط Arrange .... اضغط على Anchoring ..اختر ..Top Left

في هذه الحالة نحتاج لتفريغ البيانات القديمة من خلال استعلام حذف

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

بارك الله فيك وجعلها في ميزان حسناتك نتمى منك الكثير لاثراء هذا الموقع الرائع بالعلم والمعرفة تحياتي لك

عمل اكثر من رائع استاذ عمر نسئل الله تعالى الرحمة والمغفرة لوالدتك ولوالدينا ولجميع المسلمين وان يجعل الفردوس الاعلى مثواهم ... شكر لك

ممتازة أخى إبراهيم لكن هل ممكن الدمج بين الكود الذى تفضلت به مع هذا الكود بحيث يتم إنشاء الأزرار تلقائياً ويتم إعطائها أسماء الشيتات دون تدخل من المستخدم هذا الكود كان من إعداد أخى محمد هشام Sub shws() For i = 2 To Sheets.Count lw = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row + 1 If Sheets(i).Name <> MM Then Sheet1.Cells(lw, 1) = Sheets(i).Name ActiveSheet.Hyperlinks.Add Anchor:=Sheet1.Cells(lw, 1), Address:="", SubAddress:=Sheets(i).Name & "!A1", TextToDisplay:=Sheets(i).Name End If Next End Sub

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

تم تعديل كود اعادة الربط بكود المهندس / جعفر من موضوع لحين معرفة الخطأ فى الكود احالى للربط التلقائى مرفق البرنامج بعد التعديل HR-OmarDahyV2.rar

😀

وهذا ملفك بعد تعديل الكود ليظهر النتيجة في رسالة : 🙂 الملف الجديد.rar

الله الله الله عليك يا عمر @عمر ضاحى 🙂 شكرا شكرا على المشاركة وعلى البرنامج والجهد الراااائع 🌹 الحمدلله البرنامج اشتغل بنجاح ولكنه فقط لم ينجح في الربط بقاعدة البيانات تلقائيا إلى أن ربطتها أنا بالطريقة اليدوية التقليدية 🙂 غفر الله لك ولوالديك ورضي عنكم وأرضاكم وجمعكم الله وجميع من تحب برحمته في فسيح جناته وبحبوحة رضوانه .. اللهم آمين 🙂🤲🏼

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

وعليكم السلام اخي عمر 🙂 شكرا لك لمشاركتك هذا المجهود الكبير ، والمطلوب دائما 🙂 حصلت لي بعض الاشكالات عند فتح البرنامج ، فياريت تعالجها ثم ترفق التعديل : 1. هل انت بحاجة الى جميع هذه المكتبات ؟ انا ظهرت عندي مشكلة في عدم وجود برنامجين (لاحظ كلمة Missing) ، وتوقف البرنامج الى ان حذفت اشارة الصح √ من امام المكتبتين : . 2. الرسالة التالية كانت تشتكي لعدم وجود برنامج الجداول في المكان الذي برمجته انت فيه ، فاقترح عليك ان تضع كود يفتح نافذة اختيار الملف ، ويطلب من المستخدم التوجه له واختياره . 3. وبعد تعدي المشكلتين اعلاه ، توقفت عند هذا النموذج ، فلم اعرف ما يجب ان افعله !! . جعفر

اللهم ارحم والدة الاستاذ/ عمر صاحى واجعله قبرها روضة من رياض الجنة ـ واغفر لها البرنامج جميل جدا ولكنه يحتاج الى بعض المكتبات ارجو اضافتها ليستفيد الكل

سلطنة عمان الرائعة والجميلة 😊✌️🏻

ممكن يكون هذ هو المطلوب معاينة طباعة مع امكانية الطباعه.xls

اتفضل قمت برفع البرنامج كامل

السلام عليكم لقد عملت برنامج خاص للبحث في جميع حقول الجداول ووضعته في هذه المشاركة جرب ووافيني بالنتيجة ساضع البرنامج هنا مرة ثانية ربما يستفاد منة باقي الاعضاء تحياتي Search All Tables 2020 New.accdb

وعليكم السلام ورحمة الله وبركاته أخي أحمد .. بالنسبه للغة العربية الموقع يدعم الأسئلة باللغة الانجليزية ولكن يمكنك كتابة كلمات عربية في السؤال مثل اسماء الحقول أو كلمات البحث مثلا.. وللتغلب على قضية ان تكون الاسئلة باللغة الانجليزية قم بكتابة السؤال في مترجم جوجل ثم قم بنسخة الى الموقع باللغة الانجليزية. اما بالنسبة للكود الذي سالت عنة يمكنة كتابته بكل سهولة واكثر من ذلك 😊

لازم تحط ملف وتقول اللى انت عاوزه فيه ياغالى عشان ميحصلش تخمين

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

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

شوف المثال التالي استاذ احمد عسى ان يلبي مطلبك ..يظهر لك اخر شهر دون تدخلك loan2_Backup.rar

انا بعيد عن الكمبيوتر لكن اظن ان المرفق الذي سارفقه فيه نموذج فيه زر لارسال ملف pdf الى تبلبجرام طبعا انت يجب ان تخزن التقرير ك pdf #ثم ترسله الى تيليجرام والزر الاخر لارسال صورة تاكد من ذلك؟ accesssendtelegram.accdb

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

أخي ابحث بكلمة (محاسبي) بمنتدى الاكسس وبتحصل الكثير من البرامج المحاسبية ومنها عاى سبيل المثال تفضل

السلام عليكم ورحمة الله يمكنك استخدام الكود التالى 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

السلام عليكم شرح وافي استاذ خليفة وجميل ، جزيت خيرا احب اضيف للاخ السائل طريقة فتح قاعدة BE بعد اضافة كلمة المرور لها من خلال الواجهات افتح الواجهات ثم اعمل اعادة ارتباط بالجداول من خلال : بيانات خارجية / اختر اكسس ثم اختر ارتباط عند اختيارك للقاعدة BE سوف يطالبك اكسس بادخال كلمة المرور بكذا تم تحقيق طلبك

السلام عليكم ورحمة الله وبركاته أخواني الاعزاء @العنزي العنزي @أبو ألين @kkhalifa1960 @ابو البشر @ابو نزار@محمد التميمي @غريب طرابلس @شامل2 @at_aziz@r3dx@Matin_Murad واسف ان نسيت احدا بارك الله فيكم جميعا واشكركم على المرور والتهنئة و إن شاءالله معا نتعلم ونفيد بعضنا البعض. جزاكم الله خيرا احبتي دمتم في رعاية الله وحفظه

السلام عليكم و رحمة الله الكود يعمل على نفس الملف و لا يصلح لملف خارجى اذا اردت عملية اللصق فى مكان آخر فقم باستبدال هذه العبارة : If p > 0 Then ws.Range("O2").Resize(p, UBound(Temp, 2)).Value = Temp بهذه العبارة : If p > 0 Then ActiveCell.Resize(p, UBound(Temp, 2)).Value = Temp

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