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

المعادلة صحيحة مائة بالمائة لأن شهر أغسطس 31 يوما فلذلك لم يتم الشهر الثاني عشر حتى يكون الناتج 1 سنة وأي تعديل في المعادلة بإضافة يوم أو طرح يوم سيجعل ناتج المعادلة في غير هذه الحالات غير صحيح ربما تحتاج لحساب الفرق بين تاريخين على اعتبار أن الشهر 30 يوما فقط بدون الاهتمام بعدد ايام الشهر الحالي سواء 28 أو 29 أو 31 وهذا موجود في المنتدى يمكنك البحث عنه وهذه أحد النتائج بالتوفيق

جرب هذا ... لانه ليس لدي ماسح Public Function SelectScanner() 'يتطلب إضافة مرجع إلى “Microsoft Windows Image Acquisition Library v2.0 Dim ComDialog As New WIA.CommonDialog Dim wiaScanner As WIA.Device ' عرض نافذة لاختيار الجهاز Set wiaScanner = ComDialog.ShowSelectDevice(WiaDeviceType.ScannerDeviceType, False, True) ' إذا تم اختيار جهاز، فإن DeviceID سيحتوي على معرف الجهاز المحدد If Not wiaScanner Is Nothing Then MsgBox "تم اختيار الجهاز: " & wiaScanner.DeviceID Else MsgBox "لم يتم اختيار أي جهاز." End If End Function

السلام عليكم 🙂 الاكسس معروف بنقطة ضعفه مع الصور ، وبغض النظر عن قوة كرت الشاشة. اعطيك الصافي ، للحركة انس الصور ، و استعمل الخطوط والمربعات والدوائر لعمل شكل معين ، لان فيه نقاط x و y واللي الاكسس ممكن يرسمهم فوق صورتك ، وتلقائيا كل نقطة من هذا الشكل سيتحرك (يعني ارسم الشكل المعقد مرة واحدة بإحداثيات x و y ، ومن ثم لما تغير مكان الشكل ، تلقائيا كل نقاط الشكل ستتحرك) ، ومن الرابط التالي تقدر تتعلم كيف تعمل بعض الاشكال الغير معقدة 🙂 هذا موقع (لصاحبته crystal وهي احد محترفي الاكسس) فيه ما لذ وطاب من طرق استعمال الخطوط والمربعت والدوائر: https://msaccessgurus.com/VBA/ReportDraw_Reference.htm?ref=nolongerset.com وبعد ما تاخذ لفة على الصفحة ، اختم الموضوع بتنزيل لعبة تنس الطاولة من : الكود: https://controlc.com/ac9f4c3b الفيديو: جعفر

الحمد لله الذي بنعمته تتم الصالحات

الملف المعدل سبق معالجة الامر حيث يتم مسح البيانات قبل استدعاء التواريخ ws.Range(ws.Cells(7, 49), ws.Cells(8, Columns.Count)).ClearContents تم التعدبل حبث يتعامل مع اخر صف به اسم موظف زاد العدد او نقص واذا اردت الغاء موظف احذف الصف بالكامل لو امسحه بالكامل ws.Range("AU9:CM" & lastRow).ClearContents تم التعديل الصف الذى به بيانات يتم مسح التنسيقات ws.Range("AU" & lastRow + 1 & ":CM" & ws.Rows.Count).ClearFormats انمتى ان تجد طلباتك فى هذا الملف وان هناك اي شئ غير مكتمل فابلغنى فان لم اكن انا فالكثير من اعضاء المنتدى يقدمون المساعدة المهم الحصول على طلبك وليس المهم من قام به برعاية الله وحفظه استدعاء التاريخ أفقيا +11111.xlsm

اخي سامر رضي الله عنك وأرضاك 🤗 بما أنك لم تحصل على الحل ، فساعدنا وارسل مرفقك على الأقل 🙄 . انا الآن على سفري ، وقد لا أتمكن من رؤيته في الوقت الحالي ، عل أحد الأساتذة والإخوة يدعمك في الحل بعد إرسالك للملف 😅 .

اخي سامر الكل هنا أخوة ويساند بعضه البعض 😇 ما رأيك باستخدام الدالة Case كتجربة 😉 ، يمكن في حالة الجمل الشرطية في حالتك تكون أسهل . Select Case Me.نوع_الحركة Case "وارد" Me.w.Visible = True Me.m.Visible = False Case "منصرف" Me.w.Visible = False Me.m.Visible = True Case Else Me.w.Visible = True Me.m.Visible = True End Select حسب نوع الحركة ( منصرف ، وارد ، غير ذلك ) . وللنصيحة ، عند نسخ الأكواد وكانت تحتوي حروف عربية ، اجعل مؤشر الكتابة باللغة العربية ثم قم بالنسخ من محرر الأكواد الى المشاركة أو العكس من هنا الى هناك 🤗 جرب وأخبرنا بالنتيجة 😇

رابط البرنامج https://www.raed.net/file?id=1067611

التحويل بواسطة برنامج VB6 نسخة خفيفة حوالي 30 ميقا وتعلمتها من المنتدي ويوجد شرح مفصل للطريقة بالمنتدى للاستاذ ياسر العربي حيث قام بشرح تفصيلي لربط الاكسل بالفيجوال بيسك والتحكم بملف الاكسل عن طريقه واما التحويل الى EXEفهي ميزة موجودة بالفيجول بيسك. https://www.officena.net/ib/topic/65629-سلسلة-دروس-الفيجوال-بيسك-6-والاكسيل-من-علي-مصطبة-ياسر-العربي هذا ملف تم تحوبله الى EXE بالبرنامج المذكور المصنف1.rar

انا وندوز 10 نظام 64 بت

الكود شغال وبيظهر لى الماسح الضوئى ال عندي

وعليكم السلام ورحمة الله وبركاته تم معالجة النقطة الثاتبة وهو مسح النطاق اولا Range(Cells(7, 49), Cells(8, Columns.Count)).ClearContents التنسبق لدى فى جهازى من البمبن الى البسار واذ كان يظهر لك غير ذلك بمكنك تظليل نطاق التواربخ وبالزر الابمن اختر تنسبق خلابا ثم التاريخ واختر التنسبق المطلوب من القائمة او تعديلها من اعدادات اللغة والتاريخ لك وافر التقدبر والاحترام تعدبل الكود Sub FillDatesAndNames() Dim startDate As Date Dim endDate As Date Dim currentDate As Date Dim colIndex As Integer Range(Cells(7, 49), Cells(8, Columns.Count)).ClearContents startDate = Range("AU8").Value endDate = Range("AV8").Value colIndex = 49 For currentDate = startDate To endDate If Weekday(currentDate, vbSunday) <> 6 And Weekday(currentDate, vbSunday) <> 7 Then Cells(8, colIndex).Value = currentDate Cells(7, colIndex).Value = Format(currentDate, "dddd") colIndex = colIndex + 1 End If Next currentDate End Sub الملف استدعاء التاريخ افقيا.xlsm

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

اخونا العزيز @سامر محمود ، وعليكم السلام ورحمة الله وبركاته ارسل مرفقك وستجد العديد من الحلول بإذن الله 😇

برنامج حسابات شركات المقاولات المتكامل The Fastest ERP 2025 مع الكراك رابط تحميل البرنامج https://www.mediafire.com/file/vdcle99uuj6umxq/The+Fastest+EXE_2025.rar/file روابط شرح البرنامج على يوتيوب YouTube https://www.youtube.com/playlist?list=PLchJFI-EXcEi2ryUFq3lW3STScg7O4yOZ .مميزات البرنامج. - الحسابات العامة والختامية طبقا لمعايير المحاسبة الدولية - حسابات النقدية والبنوك ومتابعة حركة الشيكات وخطابات الضمان والنتبيه بمواعيد الاستحقاق - تعدد العملات - إدارة حسابات الأصول الثابتة ومتابعة حياذة كل اصل وحساب الاهلاك بشكل تلقائى - مراقبة المخازن - مديول كامل لشؤون العاملين الاجور والمرتبات مع ربط البرنامج بجهاز البصمة - مقايسات المشروعات وتسجيل المستخلصات مع عمل تحليل للتكاليف التقديرية للمشروع - تحليل تكاليف المواقع الفعلية والمقارنة بالتكاليف التقديرية وتحديد الانحرافات - عقود مقاولين الباطن ومستخلصاتهم - سراكى المعدات وسراكى العمال - المشتريات المحلية والمستوردة – مع تحليل تكاليف البضاعة المستوردة - حسابات العملاء والموردين ومراقبة حد الائتمان واعمار الديون - اماكانية ربط المرفات بالبرنامج واستدعائها بسهولة ويسر - ربط البرنامج بمنظومة الفاتورة الالكترونية مع رفع الفواتير الى المنظومة تلقائيا بشكل فردى او بالجملة Select All

أكيد هناك طرق أخرى ، ولكن هنا كانت الفكرة على عدد اعمدة بسيط

السلام عليكم ورحمه الله وبركاته وبها نبدأ تفضل اخي Option Explicit Sub Search_Transfer() Dim WS As Worksheet, cel As Range, lr As Long, Temp(), I As Long, J As Long, X Set WS = ThisWorkbook.Worksheets("Sheet2") lr = WS.Cells(Rows.Count, "R").End(xlUp).Row For Each cel In WS.Range("R5:R" & lr) If cel <> "" Then X = Application.Match(cel, WS.Columns(13), 0) If Not IsError(X) Then I = I + 1 ReDim Preserve Temp(1 To 15, 1 To I) Temp(1, I) = I For J = 2 To 15 Temp(J, I) = WS.Cells(X, J).Value Next J End If End If Next cel Temp = Application.Transpose(Temp) If I > 0 Then WS.Range("V5").Resize(I, UBound(Temp, 2)).Value2 = Temp End Sub