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

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

استاذى الجليل هو حضرتك تشرب سطل الشاى وانا اللى احاول واجاوب

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

نظام توارد الخواطر .... ههههه ....

سؤال جميل كل ما كان عملك اكبر ولايقتصر عملك على خوادم ويندوز واهمية العمل لديك اكبر من التكلفة المادية اوراكل خيار مرجح sql server خيار ممتاز اذا كنت تعمل تحت بيئة وتطبيقات ميكروسوفت يمتاز بالسهولة واقل تكلفة مادية ويربط بسهولة مع قاعدة اكسس اي ممكن ان عمل الجداول sql والواجهه اكسس توجد تفاصيل كثيرة ولا اجد الوقت للتفصيل حجم العمل وعدد المستخدمين والميزانية تحدد اختيارك

لعدم وجود مجلد image بجوار البرنامج تأكد جيدأ من وجود مجلد image او يمكن اشنائه عن طريق الكود التالي ( ضعه في بداية الكود ) Dim fs, cf, strFolder strFolder = CurrentProject.Path & "\" & "image" Set fs = CreateObject("Scripting.FileSystemObject") If fs.FolderExists(strFolder) = False Then MsgBox "تحذير !!! مجلد المرفقات غير موجود ! وسيتم انشائه ان شاء الله بجوار البرنامج", vbExclamation, "Pro2020" Set cf = fs.CreateFolder(strFolder) وهذا هو الكود كاملاً ان شاء الله Dim fs, cf, strFolder strFolder = CurrentProject.Path & "\" & "image" Set fs = CreateObject("Scripting.FileSystemObject") If fs.FolderExists(strFolder) = False Then MsgBox "تحذير !!! مجلد المرفقات غير موجود ! وسيتم انشائه ان شاء الله بجوار البرنامج", vbExclamation, "Pro2020" Set cf = fs.CreateFolder(strFolder) If IsNull([FCar_No]) Then [FCar_No].SetFocus Exit Sub End If Dim fpath As Variant Dim fpathz As Variant With Application.FileDialog(3) .Title = "Choose File" .Filters.Clear .Filters.Clear .Filters.Add "All Files", "*.*" .Filters.Add "jpg image", "*.jpg" .Filters.Add "jpeg image", "*.jpeg" .AllowMultiSelect = False .InitialFileName = "" If .Show = -1 Then fpathz = .SelectedItems(1) Name fpathz As Application.CurrentProject.Path & "\image\" & [FCar_No] & ".jpg" Me.PicFile = Application.CurrentProject.Path & "\image\" & [FCar_No] & ".jpg" End If End With End Sub تحياتي

المصحف الرقمى - مجمع الملك فهد 2.zip

السلام عليكم اخى @radwan1991 مشاركه مع اخوانى واساتذتى جزاهم الله خيرا جرب الكود التالى جزاها الله خيرا ام عهود اذا كان نموذجك لا يوجد به كومبوبوكس ازل الجزء من الكود Or ctlTextbox.ControlType = acComboBox For Each ctlTextbox In Me.Controls If ctlTextbox.ControlType = acTextBox Or ctlTextbox.ControlType = acComboBox Then If IsNull(ctlTextbox) Then MsgBox "لقد تركت أحد مربعات النص فارغاً" ctlTextbox.SetFocus Exit Sub End If End If Next ctlTextbox MsgBox "جميع مربعات النص بها قيم " On Error GoTo Erra Dim stDocName As String stDocName = "t1" DoCmd.OpenReport stDocName, acNormal Exit_Erra: Exit Sub Erra: MsgBox Err.Description Resume Exit_Erra Database11(2).accdb

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

Nz(DSum("[Expr1]";"[Q1]";"[id] =" & [id] & "And [Dat_bill] Between #01/01/2020# And #31/01/2020#");0) مثال اوفيسنا الدالة dsum(1).accdb

انا معاك بقى اخى واستاذى @kha9009lid بحب الرواقه والقهوه عندى المرادى 😀 الفطور جاهز ةالشاى والقهوه جزاكم الله خيرا وربنا يوفقكم ويروق بالكم باذن الله

تفضل اخي لعله المطلوب Book1 (1).xls

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

المثال كان لاختبار حقل الاسم فقط Name اذا اردت جميع الحقول فمثال الاخ العزيز @احمد الفلاحجي مميز لفحص جميع الحقول

تم بحمد الله تعالى وفضله التوصل للنتيجة المطلوبة موديول لتجميع كل السجلات فى حقل واحد Public Function ToMrg() As String Dim strTemp, i Dim strSQL As String strSQL = "select Aya from tblAyatSource;" strTemp = CurrentProject.Connection.Execute(strSQL).GetRows For i = 0 To UBound(strTemp, 2) ToMrg = ToMrg & strTemp(0, i) & Space(1) Next ToMrg = Mid(ToMrg, 1, Len(ToMrg) - 1) End Function والان موديول فصل الايات من حقل واحد الى جدول اخر لتكون كل اية فى سجل Public Sub ToSplitForTabel() Dim db As DAO.Database Dim rs As DAO.Recordset Dim rsADD As DAO.Recordset Dim strSQL As String Dim strField1 As String Dim strField2 As String Dim varData As Variant Dim i As Integer Set db = CurrentDb strSQL = "SELECT ayat FROM TableA " Set rsADD = db.OpenRecordset("TableB", dbOpenDynaset, dbAppendOnly) Set rs = db.OpenRecordset(strSQL, dbOpenDynaset) With rs While Not .EOF strField1 = !ayat varData = Split(strField1, ChrW(1757)) For i = 1 - 1 To UBound(varData) With rsADD .AddNew !ayat = varData(i) & ChrW(1757) .Update End With Next .MoveNext Wend .Close rsADD.Close End With Set rsADD = Nothing Set rs = Nothing db.Close Set db = Nothing End Sub

وعليكم السلام عدد ايات القران الكريم بحدود 6236 اية بدون البسملة اقصى عدد لحقول الجدول الواحد 255 حقل عدد ايات بعض السور مثل سورة البقرة 268 ومعناها ان عدد اياتها اكبر من استيعاب جدول واحد ممكن يكون كل سورة في جدول ومعناها اننا نحتاج الى 114 جدول +1 جدول لبقية سورة البقرة اي 115 جدول ايضا توجد ايات عددها اكبر من استيعاب عدد حروف الحقل النصي 255 حرف مثل الاية الدين في سورة البقرة 551 حرف لست خبير في مواضيع الاستيراد ولكن اعتقد ان ذلك ممكن ولكن بجهد كبير

سياره ام طياره ؟ ساذهب للدوام وللتسوق بالسياره ... ساسافر بالطياره تحياتي

السلام عليكم ورحمة الله تعالى وبركاته اساتذتى الافاضل لاحظت الكثير من الاخطاء عند العمل على المصاحف الرقمية وبفضل من الله تحصلت على ملف ورد من مجمع الملك فهد لطباعة المصحف الشريف اريد كل ايه فى سجل هل يمكن عمل ذلك برمجيا المصحف الرقمى - مجمع الملك فهد.mdb UthmanicHafs1 Ver13.doc

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

تفضل قم بفك الضغط عن الملف وانسخ الملفين في هذا الامتداد "C:\Windows\System32" بعدها تذهب الى قائمة ابدا وتدخل على موجة الاوامر وقد تجدها باسم cmd يمكنك الدخول عليها عن طريق امر تشغيل او في البرامج الملحقة لا تفتحها مباشرة عندما تجدها اتبع التعليمات كما في الصور MSCAL.rar اكتب كما في الصورة ثم انتر اذهب الى برنامجك وسيشتغل كما في الصورة

هذه احدى البرامج من المنتدى .... انظر .....

اختي الكريمة تفضلي لقد قمت باضافة زر تعديل بدل بحث وتعديل من جعلهم زر واحد في اليوزرفورم 2.xlsm

ممكن توضيح اكثر

جزاك الله خير على الدعاء والشكر لله سبحانه 🌹

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

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

بعد اذن الاستاذ عبدالفتاح في بي اكسيل واثراء للموضوع جرب هذه الطريقة اليك هذا الماكرو Sub pastespcolwid() ' Keyboard Shortcut: Ctrl+q ActiveCell.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False ActiveSheet.Paste End Sub ضعه في مديول ثم اهب الى Macro ثم Options ثم ادخل حرف Q لاختصار الماكرو انظر الصورة الماكرو ينفذ عملية اللصق عن طريق لوحة المفاتيح والطريقة هي : حدد النطاق الذي تريد ثم نسخ ثم اذهب الى مكان اللصق ثم على لوحة المفاتيح اضغط زر CTRL+Q وهذا المرفق Book1.xlsm

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

اخي اين الملف حتى نعرف المدى والورقة التي ستطبق عليها عالعموم هذا ملف به كود برمجي بمجرد الضغط عليه يتم نسخ المدى بنفس عرض العمود في نفس ورقة العمل Sub width_col() Sheets("sheet1").Range("A1:e50000").Copy With Sheets("sheet1").Range("G1") .PasteSpecial xlPasteColumnWidths .PasteSpecial xlPasteValues, , False, False .PasteSpecial xlPasteFormats, , False, False End With Application.CutCopyMode = False End Sub FORMAT WIDTH‬.xls

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله خيرا تم ازاله الصف الاول بالتتغير الى false لم اجد فالتعليمات للامر خاصيه الفتح فقمت باستدعائه بالشل ارجو ان يكون ما تريد وان شاء الله اخواننا واساتذتنا يساعدون بحلول افضل DoCmd.TransferText acExportDelim, "qry", "استعلام4", strPathAndfile & xx & ".txt", False Shell ("C:\Windows\system32\notepad.exe" & " " & strPathAndfile & xx & ".txt"), vbNormalFocus بالتوفيق اخى Trans CD.mdb

عندك هذه المعادلة فيالخلية C2 ولا أفهم ما هي =TickerChart|Live!'QO.1111.TAD$lasttradeprice' الرجاء كتابة التنائج يدوياً لمعرفة المطلوب

هلا اخي اعمل مرجع الى Microsoft Scripting Runtime بالتوفيق

بعد اذن الاساتذة هذ ا كود ديناميكي Sub TransferData() Dim a, b, i&, Dic As Object Set Dic = CreateObject("scripting.dictionary") a = Sheets("Sheet1").[B7].CurrentRegion ReDim b(1 To UBound(a), 1 To 10000) For x = 2 To UBound(a) If Not Dic.exists(a(x, 2)) Then i = i + 1 Dic.Add a(x, 2), i b(1, i) = a(x, 2) End If i = Dic(a(x, 2)) For y = 2 To UBound(b) If IsEmpty(b(y, i)) Then b(y, i) = a(x, 3) Exit For End If Next Next Sheets("Sheet2").[C8].Resize(UBound(b), UBound(b, 2)) = b End Sub POSTING.xls

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

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

جزاك الله خيراً استاذ وجيه و تقبل الله صالح الاعمال

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

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

كلام الاستاذ رمهان صحيح 100% هو فقط اختصر ما كتبته انا في 19 سطر هو كتبه في سطرين بعد اذن اخي ابو تراب الفائدة باختصار مستخدمين اكثر بيانات اكثر حسب نسخة sql مجانية او مدفوعة الثمن امان اكبر نسخ احتياطي بخيارات اكبر دعم للانترنت

إخوتي الفضلاء أخي الحبيب أبو خليل أرفق لكم ما فتح الله به عليّ ، مما أدركت من طلبك أخي الحبيب (آملاً أن أكون قد أحسنت الفهم عنك) أهم ما في المسألة الإلتزام بما أسلفت ذكره في المشاركة 6 من تأكيد على تنسيق وأتمتة إسم الملف. وفي المرفق نسخة من مجلد الملفات لإعادة النسخ في المجلد xx . جرِّب ووافني بالنتيجة ........ والله من وراء القصد ................ NA_DeleteFiles.rar

شاهد المرفق اخى book2.rar

الكود التالي أكثر إختصاراً ويؤدي نفس الغرض: Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row = 15 Then Cells(1, Target.Column + 1).Select End Sub _________________________.rar