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

حل آخر بدون كود vba: =IF(RIGHT(A1,1)="-",VALUE(TRIM(LEFT(A1,LEN(A1)-1)))*-1,VALUE(TRIM(A1))) المثال لا يوجد به أرقام بالموجب لذلك لا أضمن المعادلة ستنجح مع الأرقام الموجبة أو لا. العلامة بالسالب_01.xlsx

السلام عليكم ورحمة الله وبركاته السبب هنا عند لصق الارقام الى الاكسل فان علامة السالب اصبحت فى ناحية اليمين اليك الملف يحتوى على كود vba لتعديل مكان علامة السالب من اليمين الى اليسار كل ما عليك هو تحديد الارقام التى تريد تعديلها ثم النقر على زر تعديل الارقام وسوف يقوم بحل المشكلة باذن الله تعالى واليك صورتين لكيفية العمل ايضا العلامة بالسالب.xlsm

مشكوووور يا غالي @kanory سأقوم بالتجربة غداً في العمل ، في المنزل ليس لدي انترنت 🤗

وعليكم السلام أخي @Foksh هذا الملف يفيدك kan.accdb

تمام 100 % احسنت جزيت خيرا جربت الكود - ممتاز واذا يوجد ابلغك

السلام عليكم ورحمة الله وبركاته اخى الفاضل @kkfhvvv تفضل هذا الكود يقوم بتصفية البيانات للثلاث الاعمدة جربه لعله يكون المطلوب Sub RemoveDuplicatesRange() Dim lastRow As Long lastRow = Sheets("البيانات").Cells(Sheets("البيانات").Rows.Count, "O").End(xlUp).Row Sheets("البيانات").Range("O1:Q" & lastRow).Copy Sheets("ارقام").Range("A1").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False lastRow2 = Sheets("ارقام").Cells(Sheets("ارقام").Rows.Count, "A").End(xlUp).Row Sheets("ارقام").Range("$A$2:$C$" & lastRow2).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlNo End Sub تقبل تحياتى

تسلم ايدك ..

جميل جداً .. وبعد أذن أخي الكريم @alaa aboul-ela =DCount("[ID]","Table1")

تفضل مشاركتي البسيطة ، حيث Open_Key اسم الزر الذي ستستخدمه لتنفيذ الكود . Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _ (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _ ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Sub OpenKeyboard() Dim osVersion As String Dim command As String osVersion = GetOSVersion() If osVersion = "10" Then command = "osk.exe" Else command = "osk.exe" End If ShellExecute 0, "runas", command, vbNullString, vbNullString, 1 End Sub Function GetOSVersion() As String Dim osVersion As String osVersion = SysCmd(acSysCmdAccessVer) GetOSVersion = Left(osVersion, InStr(osVersion, ".") - 1) End Function Private Sub Open_Key_Click() OpenKeyboard End Sub وهذا مرفق للتجربة Keyboard.accdb مع العلم أنه تمت تجربة كود الأستاذ @Moosak ويعمل بكفاءة

جرب ده كده DCount("id", "tabel1" dcount.rar

السلام عليكم 🙂 تفضل هذا شريط تقدم بدون استخدام التايمر 🙂 شريط تقدم بدون تايمر.accdb

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

السلام عليكم مشاركة معكم احبتي الأخطاء طفيفة فقط بحاجة الى تأني كالتالي : 1- اعلن عن المتغيرات integr والواجب تكون Dbl 2- في المقارنة اخطأ ووضع اصغر من بدلا من اكبر من ... وهذه هي مشكلته الأساسية ايضا داخل الكود تسميات الحقول تنتهي بحرف L والصح تنتهي برقم واحد ... وطبعا صعب التفريق بينها عند المشاهدة Ab.rar

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

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

الحمد لله .. جزاك الله خير

تأكد من ربط المفتاح الاساسي بين الرئيسي والفرعي

افضل استاذ @saffar اليه من تحديث للمرفق . اليك الشرح والمرفق . ووافني بالرد tah-4.rar

مشاركة مع اخي الفاضل @kkhalifa1960 التعديل::::: عدم اختيار خمس مواد واذا تم الاختيار يقوم البرنامج بمسح اخر اختيار حفظ الاختيارات في الجدول عند فتح النموذج مرة اخرى تجد نفس الاختيارات موجود ( للتعديل - الالغاء - الاضافة ) في نفس الليست بوكس تعديل التقرير حسب اسم الطالب انظر الصورة ..... tah.accdb

الطلب بعد التعديل راجعة ثم وافني بالرد . tah-3.rar

تفضل أخي التعديل @alhourriah التعديل . If Len(Me.comp_user & "") = 0 Then Beep MsgBox "Put User Name", vbCritical Undo Me.comp_user.SetFocus Exit Sub End If

بعد اذنكم اضيف مشاركة . واذا لاتريد فتح التقرير في اضافة بسيطة عند تصير التقرير . ' , , , acHidden Badge_Output = Application.CurrentProject.Path & "\Badges.PDF" stDocName = size DoCmd.OpenReport stDocName, acViewPreview, , , acHidden DoCmd.OutputTo acOutputReport, stDocName, acFormatPDF, Badge_Output, True, , , acExportQualityPrint DoCmd.Close acReport, stDocName

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

اسأل الله العلي القدير ان يرحم والدك ويرحم امواتنا جميعاً اللهم امين

بارك الله لك وتقبل منك شيت تحفه

السلام عليكم أخي الكريم عرضت طلبك على الذكاء الاصطناعي فكان الرد كالتالي: - راجياً أن يفيدك في بحثك بالطبع! سأقدم لك نصائح حول تصميم وإنشاء معدل طالب بعد التخرج مع مصادر البحث. دعنا نبدأ: تصميم البحث: قبل البدء في البحث، حدد نوع البحث (نوعي أم كمي) والتصميم (وصفي أم ارتباطي أم تجريبي). حدد مجتمع البحث والعينة المستهدفة. مكونات خطة البحث: صفحة الغلاف: تحتوي على العنوان المقترح واسم الباحث واسم المشرف والجامعة أو المؤسسة. الملخص وجدول المحتويات: يساعدان القارئ على التنقل بين محتويات الخطة البحثية. الأهداف: إقناع القارئ بأن مشروعك ممتع وأصلي ومهم. تقديم البحث للقارئ والتأكيد على فهمك العميق للموضوع. إظهار اهتمامك بالبيانات والأدوات والإجراءات التي ستستخدمها في البحث. التأكيد على أن البحث يتوافق مع القيود والشروط المحددة من قبل الممول أو الجامعة. عدد صفحات خطة البحث: يختلف حسب نوع البحث. يمكن أن تكون خطة البكالوريوس أو الماجستير قصيرة، بينما تكون خطة دراسة الدكتوراه طويلة ومفصلة. للمزيد من التفاصيل ونموذج خطة بحث جاهزة، يمكنك الاطلاع على المقالة المقدمة من المؤسسة العربية للعلوم ونشر الأبحاث 1. أتمنى لك التوفيق في دراستك وبحثك! 📚🔍 يرجى مراجعة الرابط التالي لعله يفيدك في بحثك مع أطيب التمنيات https://drasah.com/Description.aspx?id=3472

وعليكم السلام ورحمة الله تعالى وبركاته بما ان البيانات من على النمودج ثابثة باستثناء( نوع الطلبية _ والوقت _ و رقم الطلبية) يمكنك محاولة ادراج ملخص الطلبية مباشرة بدون الاعتماد عليه جرب هدا الحل ربما يناسبك Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Exitsub If Target.Row > 1 And Target.Column < 17 Then Dim lr As Long, r As Long Set WS = Sheet1 lr = WS.Range("i" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False With WS.Range("r2:r" & lr) .Formula = "=IF(I2<>"""",""في تمام الساعة( ""&CONCATENATE(TEXT(L2,""HH:mm"")&"" ) ""&""تم طلب "")&I2&"" ""&""منطقة (""&A2&"") "" &""وصول""&"" ""&"" ""&I2&"" ""&""الساعة""&"" ( ""&CONCATENATE(TEXT(N2,""HH:mm"")&"")""&"" ""&"" رقم الطلبية ( "")&F2&"") "","""")" .Value = .Value End With For r = 2 To WS.Cells(Rows.Count, "r").End(xlUp).Row If WS.Range("i" & r).Value = "" Then WS.Range("r" & r).Value = "" Next r End If Exitsub: End Sub نموذج V1.xlsm

جرب هدا الحل بعد اظافة اليوزرفورم هل يناسبك باسوورد 0 الاعمال الجنوبية userform.xlsm

تفضل استاذ @saffar مرفقك حسب طلبك وفهمي له بعد التعديل .ووافني بالرد . tah-2.rar

تفضل استاذ @saffar مرفقك حسب طلبك وفهمي له .ووافني بالرد . tah-1.rar

انى اتسائل يا استاذ / عماد هل هذه قاعدة بيانات لمكتبة فيها كتب وما علاقة الموظفين بالكتب سؤالى الثانى اين الرقم العام للكتاب والرقم الخاص حسب تقسيم (ديوى العشرى) اسف وسامحنى لاسئلتى فمادة المكتبات فكنت اقوم بتدريسها فى احدى جامعات مصر واذا كانت قاعدة البيانات هذه لغير المكتبات فاعتبر ان لم اسأل جزاك الله كل خير

وعليكم السلام ورحمة الله تعالى وبركاته جرب الحلول التالية ربما هدا ما تقصده Sub test1() Dim crit$, crit2$, F() As String Dim rng As Range, lr As Long Dim WS As Worksheet: Set WS = Sheets("Sheet1") Dim desWS As Worksheet: Set desWS = Sheets("Sheet2") ReDim F(1 To 4) 'Bill Type Code ******************************************Action Type & Terminal Type F(1) = "240": F(2) = "2400": F(3) = "26408": F(4) = "293": crit = "DEB": crit2 = "INT" Application.ScreenUpdating = False If WS.AutoFilterMode Then WS.AutoFilterMode = False With WS.Range("A2:K2") .AutoFilter 3, F, xlFilterValues: .AutoFilter 4, crit, xlFilterValues: .AutoFilter 11, crit2, xlFilterValues lr = WS.Columns("A:A").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row Set rng = WS.Range("A3:K" & lr).SpecialCells(xlCellTypeVisible) If rng.Cells.Count > 1 Then desWS.Range("A2:F" & Rows.Count).Clear With rng Cpt = Split("A,B,D,J,G,K", ",") ' الاعمدة المرحلة Col = Split("A,B,C,D,E,F", ",") 'الاعمدة المرحل اليها For i = LBound(Cpt) To UBound(Cpt) WS.Range(Cpt(i) & "2:" & Cpt(i) & lr).Copy desWS.Range(Col(i) & "1") Next i End With End If .AutoFilter Application.ScreenUpdating = True End With End Sub ''''''''''''''''''''''''''''''''''''''' Sub test2() Dim a, i&, k&, F$, S$: F = "DEB": S = "INT" Dim WS As Worksheet: Set WS = Sheets("Sheet1") Dim desWS As Worksheet: Set desWS = Sheets("Sheet2") Application.ScreenUpdating = False desWS.Range("A2:F" & Rows.Count).Clear a = WS.Range("A2:K" & WS.[A65000].End(xlUp).Row) For i = 1 To UBound(a) 'Action Type & Terminal Type If a(i, 4) = F And a(i, 11) = S Then ''Bill Type Code If a(i, 3) = "240" Or a(i, 3) = "2400" Or a(i, 3) = "26408" Or a(i, 3) = "293" Then ' الاعمدة المرحلة desWS.Cells(k + 2, 1).Resize(, 6) = Application.IfError(Application.Index(a, i, Array(1, 2, 4, 10, 7, 11)), "") k = k + 1 End If End If Next Application.ScreenUpdating = True End Sub ملف عمليات V1.xlsm

يمكننا ضبط الكود لتحقيق ذلك. يتم وضع كل اسم في خلية واحدة، والأسماء المختلفة تُفصل بواسطة سطر جديد في نفس الخلية. اليك الكود المعدل Private Sub Workbook_Open() ' جعل الصفحة من اليمين والتنسيق في المنتصف With ActiveWindow .WindowState = xlMaximized .DisplayRightToLeft = True End With ' تنسيق الأرقام بخط عريض بحجم 14 Cells.NumberFormat = "0" Cells.Font.Size = 14 ' تنسيق العمود A برقم مخصص 000000 Columns("A").NumberFormat = "000000" ' تنسيق العمود B بتكست Columns("B").NumberFormat = "@" ' تقسيم الأسماء في العمود C Dim lastRow As Long lastRow = Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To lastRow Dim fullNameA As String Dim fullNameB As String Dim combinedNames As String ' قراءة الأسماء من العمود A و B fullNameA = Cells(i, "A").Value fullNameB = Cells(i, "B").Value ' المقارنة والتحقق من الأسماء المتطابقة If InStr(fullNameB, fullNameA) > 0 Or InStr(fullNameA, fullNameB) > 0 Then combinedNames = fullNameA Else combinedNames = fullNameA & vbCrLf & fullNameB End If ' وضع الأسماء في العمود C Cells(i, "C").Value = combinedNames Next i End Sub

اللهم اغفر له وللمسلمين جميعا

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

جميعا بإذن الله