اذهب الي المحتوي
أوفيسنا

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

  1. Ali Mohamed Ali

    Ali Mohamed Ali

    المشرفين السابقين


    • نقاط

      14

    • Posts

      11,621


  2. ابراهيم الحداد

    • نقاط

      4

    • Posts

      1,247


  3. ابوخليل

    ابوخليل

    أوفيسنا


    • نقاط

      3

    • Posts

      11,622


  4. ياسر خليل أبو البراء

    ياسر خليل أبو البراء

    المشرفين السابقين


    • نقاط

      2

    • Posts

      13,165


Popular Content

Showing content with the highest reputation on 27 ماي, 2023 in all areas

  1. وعليكم السلام-ياريت تقوم بتغيير عنوان المشاركة ليصبح ( معادلة IF متعددة الشروط) وهذه المعادلة تفى بالغرض وشكراً =IF(AND($C4<>"غ",$B4="ذكر"),"ناجح",IF(AND($C4<>"غ",$B4="أنثي"),"ناجحة",IF(AND($C4="غ",$B4="ذكر"),"ناجح بحكم القانون",IF(AND($C4="غ",$B4="أنثي"),"ناجحة بحكم القانون","")))) معادلة IF.xlsx
    3 points
  2. تفضل علما ان حقول القيمة لديك نصية ، والمقارنة باكبر من او اصغر يجب ان تكون الحقول رقمية تم عمل متغير رقمي يمثل القيمة النصية Dim i, ii As Integer i = Nz(DLookup("[estelak]", "[OLD_BASIC_DATE]", "[crn] ='" & [Forms]![BASIC_DATE]![address] & "'"), 0) ii = Me.ADD_NO If ii < i Then Beep If MsgBox("الإستهلاك الذى تريد تسجيله حالياً أقل من الإستهلاك السابق هل تريد إضافة القيمة؟", _ vbQuestion + vbYesNo, _ "تننبيه") = vbYes Then Exit Sub Else Undo Exit Sub End If End If New Microsoft Access Database2.accdb
    2 points
  3. السلام عليكم و رحمة الله شاهد هذا المرفق ربما يكون هو طلبك يمكنك التعديل عليه بما يتوافق مع رغباتك ViewPicts.rar
    2 points
  4. تفضل لك ما طلبت ان يكون التقرير بصفحة منفصلة .. لكن لما كل هذا التأخير عند الرد ؟!!! افرض كنت مشغول !!!! وأعتقد ان المعادلة سهلة ولا تحتاج شرح =LOOKUP(2,1/(ورقة1!$A$3:$A$440=$B4),ورقة1!$D$3:$D$440) فالجزء الأول من المعادلة ورقة1!$A$3:$A$440=$B4 يقصد به العمود A الموجود بصفحة ورقة1 والذى يخص أسماء أولياء الأمور ثم =الخلية B4 ,والتى بها اسم ولى الأمر الموجود بصفحة التقرير المراد البحث به ثم بعد ذلك النطاق ورقة1!$D$3:$D$440 وهذا هو النطاق الموجود به نتائج البحث وهو عمود رقم السند الموجود بصفحة ورقة1 ..ومعادلة تاريخ السند مثل رقم السند بالضبط مع اختلاف عمود النتيجة بدلاً من العمود D سيكون العمود E ولكم جزيل الشكر أتمنى ان يكون الأمر سهل لك Aziz2.xlsx
    2 points
  5. رووووووووعة بارك الله فيك وجزاك الله كل خير لقد بدأت بالفعل شاكرا لك دعمك وتعاونك@kkhalifa1960
    1 point
  6. تفضل الصق هذه الشفرة في سجل الأكواد Module1 Public Function Get_Last_PRICE(ITEM_CODE As String) As Double On Error Resume Next Get_Last_PRICE = Nz(DLast("PURSHASED_PRICE", "ITEMS", "[ITEM_CODE] Like '" & ITEM_CODE & "'"), 0) End Function و في صفحة المبيعات و صفحة المشتريات في حدث عند التغيير ضع الكود التالي [ITEM_PRICE] = Get_Last_PRICE([ITEM_CODE]) وهذه هي النتيجة لم استطع ارفاق التعديل بسبب كبر حجم الملف
    1 point
  7. هنا أنت تقارن بين شيئين مختلفين لا علاقة بينهما ، التقسيم الهدف منه التمكين من عمل أكثر من مستخدم على نفس قاعدة البيانات ، أما تحويل القاعدة لـ accde لحماية عناصر البرنامج من التحرير ومنع المتطفلين. انتبه ثم انتبه ثم انتبه .. !!! هذه نقطة مهمة جدا جدا حتى لا تقع في الفخ !!! 🙂 يجب أن تحتفظ بنسخة accdb معك قبل أن تحول البرنامج الى accde ، لأن نسخة accde لايمكن تحريرها أو التعديل عليها بأي شكل من الأشكال .. هي نسخة مقفلة لاستخدام العميل فقط .. وأنت كمبرمج يجب أن تحتفظ عندك بالملفات الأصلية القابلة للتعديل ..
    1 point
  8. 2,1/ هذا جزء أساسى بالمعادلة لإستخراج أخر عملية ولا تصلح المعادلة بدون هذه الجزئية وهذا الكود لطلبك الأخر ورجاءاً لابد من غلق المشاركة فلا يمكن ان يكون هناك أكثر من طلب بالمشاركة الواحدة ..فإنت أردت طلبات أخرى لابد من عمل مشاركة جديدة بالطلبات الجديدة ولكم جزيل الشكر Sub RowDeleter() On Error Resume Next Application.ScreenUpdating = False Range("E1:E" & Range("E" & Rows.Count).End(3)(1).Row).AutoFilter 1, 0 Range("E4:E" & Range("E" & Rows.Count).End(3)(1).Row).SpecialCells(12).EntireRow.Delete ActiveSheet.AutoFilterMode = False Application.ScreenUpdating = True End Sub Aziz3.xlsb
    1 point
  9. السلام عليكم و رحمة الله الزر المشار اليه هو كان لكود يقوم بجلب الصورة حسب الاسم الموجود فى التكست بوكس و قد تم الغاء الكود و سقط سهوا منى ازالة الزر يمكنك ازالته دو ن اى ضرر
    1 point
  10. السلام عليكم و رحمة الله عذرا على الخطأ اجعل الكود هكذا Private Sub ComboBox1_Change() Dim NameFound As Variant Dim FPath As String FPath = ThisWorkbook.Path & "\" NameFound = ComboBox1.Value FPath = ThisWorkbook.Path & "\" On Error Resume Next Image1.Picture = LoadPicture(FPath & "\" & "Images" & "\" & "NoPict.jpg") Image1.Picture = LoadPicture(FPath & "\" & "Images" & "\" & NameFound & ".jpg") End Sub
    1 point
  11. السلام عليكم ورحمة الله وبركاته الأخ الفاضل الخلوق أستاذ / محمد هشام أسعد الله صباحك بكل خير أولا أود أن أشكر لك اهتمامك بحل مشكلتي أسأل الله أن يجزيك عني خير الجزاء حضرتك قمت بمجهود رائع وأنجزت لي حل مشكلتي شكر الله لك صنيعك وجعله في ميزان حسناتك وأسأل الله أن يحسن إليك كما أحسنت إليّ بارك الله فيك وفي علمك وزادك علم وتقدم وابداع ثانيا أعتذر لحضرتك على التأخر في الرد نظرا لأن بالأمس الجمعة كنت في إجازة وجهاز الكمبيوتر موجود في الشركة
    1 point
  12. تفضل جرب اخي ووافينا بالنتيجة Sub RefreshData() ' تعديل Dim i As Long, k As Long Dim last_Dest As Long, lastrow As Long Dim ws_data As Worksheet: Set ws_data = Worksheets("data") For Each ws_dest In ThisWorkbook.Worksheets lastrow = ws_data.Cells(ws_data.Rows.Count, 1).End(xlUp).row last_Dest = ws_dest.Cells(ws_dest.Rows.Count, 1).End(xlUp).row Application.ScreenUpdating = False For i = 2 To lastrow For k = 2 To last_Dest 'في حالة وجود اوراق اخرى على المصنف قم باظافتها هنا If ws_dest.Name <> ws_data.Name And ws_dest.Name <> "اليومية" And ws_dest.Name <> "ورقة6" Then ' شرط تطابق عمود التسلسل وعمود التوجيه If ws_dest.Cells(k, 1).Value = ws_data.Cells(i, 1).Value And _ ws_dest.Cells(k, 2).Value = ws_data.Cells(i, 2).Value Then _ 'في حالة تحقق الشرط ws_dest.Cells(k, 3).Value = ws_data.Cells(i, 3).Value 'التاريخ ws_dest.Cells(k, 4).Value = ws_data.Cells(i, 4).Value ' البيان ws_dest.Cells(k, 5).Value = ws_data.Cells(i, 5).Value 'مدين ws_dest.Cells(k, 6).Value = ws_data.Cells(i, 6).Value 'دائن ws_dest.Activate 'تسطير تلقائي للبيانات DL = ws_dest.Range("A65500").End(xlUp).row DC = ws_dest.Cells(1, Columns.Count).End(xlToLeft).Column ws_dest.Columns("A:F").Borders.LineStyle = xlNone ws_dest.Range(Cells(2, 6), Cells(DL, DC)).Borders.Weight = xlThin End If End If Next Next Next ws_dest ws_data.Activate MsgBox "تم التعديل بنجاح", 64 Application.ScreenUpdating = True End Sub Sub transfer_data() ' ترحيل Dim Sh As Worksheet Dim ws_data As Worksheet: Set ws_data = Worksheets("data") For Each Sh In ThisWorkbook.Worksheets For R = 2 To [B20000].End(xlUp).row If Cells(R, 2).Value = Sh.Name And Cells(R, 2).Value <> Empty Then Application.ScreenUpdating = False Cells(R, 2).Resize(1, 5).Copy Sh.Range("B" & Sh.[B20000].End(xlUp).row + 1) End If Next Next For Each Sh In Worksheets 'في حالة وجود اوراق اخرى على المصنف قم باظافتها هنا If Sh.Name <> "اليومية" And Sh.Name <> "data" And Sh.Name <> "ورقة6" Then Sh.Activate Sh.Range("A3:A1000").ClearContents Sh.Range("A3") = 1 Sh.Range("A3:A" & Range("B" & Rows.Count).End(xlUp).row).DataSeries , xlDataSeriesLinear DL = Sh.Range("A20000").End(xlUp).row DC = Sh.Cells(1, Columns.Count).End(xlToLeft).Column Sh.Columns("A:F").Borders.LineStyle = xlNone Sh.Range(Cells(2, 6), Cells(DL, DC)).Borders.Weight = xlThin End If Next MsgBox ("تم بحمد الله ترحيل القيود لا تنسى أن تشكر الله علي هذه النعم "), vbOKOnly + vbInformation, "لاتنسونا من صالح الدعاء لنا ولولدينا وللمسلمين" ws_data.Activate Application.ScreenUpdating = True End Sub استدعاء من عدة شيتات- V3.xlsm
    1 point
  13. وعليكم السلام -تفضل لك ما طلبت .. وكان لابد من رفع الملف بدون ضغط , طالما حجم الملف صغير وذلك تجنباً لإهدار الوقت وشكراً Aziz1.xlsx
    1 point
  14. عذراً خطأ طباعي Book1.xlsm
    1 point
  15. تفضل جاهز إن شاء الله جمع الكشوفات1 - ماكرو.xlsm
    1 point
  16. وعليمن السلام بالإذن خيار آخر Sub test() Dim a, b: Dim lr& a = ActiveSheet.Range("D6:D14").Resize(, 4) ReDim b(1 To 5) b = Array(1, 3, 5, 7, 9) Workbooks.Open ("C:\Users\Ehab Elhady\Desktop\1.xlsx") With Sheets("sheet1").Cells(1, 1).Resize(, 5) lr = .Cells(Rows.Count, 1).End(xlUp).Row .Offset(lr).Value = Application.Index(a, b, 1) .Offset(lr, 5).Value = Application.Index(a, b, 4) End With Workbooks("1.xlsx").Close True End Sub
    1 point
  17. Select the desired row and right-click to copy Select one cell then go to the Name Box and type A5144 Right-click and paste
    1 point
  18. السلام عليكم ورحمة الله وبركاته ما الفائدة من أن تقرأ ولا تتفكر فيما تقرأ ؟! وما الفائدة إن تفكرت ولم ينعكس ذلك علي حياتك وسلوكك؟! ما الفائدة من أن تتعلم ولا تُعَلِم؟ أو أن تتكسب ولا تنفق؟! إن لم يكن ما يأتيك يخرج بصورة أفضل مما آتاك فهناك إذاً خلل… البذرة إن أعطيت للأرض أخرجت نبتة… فاجعل ذاتك أرضاً خصبة، كلما غُرِسَ فيها غرسٌ أنبتت ثمرة… وكن خليفة الله في أرضه ويداً لعباده ممتدة… واما بعد فكرت اني اعمل قالب يسير لمن يحتاجه التصميم بشكل جيد الفكرة جات من Blogger انه عامليين قوالب للمستخدم يقدر يستخدمها حسب حاجته ويطوعها حسب استخدامته Business Application Final Template مميزات القالب شاشة دخول للمستخدمين مع تحديد صلاحيات المستخدم -ادمن - مندوب بيع - مندوب شراء شاشات الانتقال تفاعلية بتعطي طابع للمستخدم بالراحة للرؤية مع استخدام الانفوجرافيك في الانتقالات المتعدة هاناخد فكرة عمل الشاشات - المشتريات - المبيعات - المخزون - المستخدم - الاعدادات والتقارير خيار الانتقال ينشط حسب صلاحية الدخول الوظايف المتعلقة بالشاشة الرئيسة المبيعات المشتريات المخزون التقارير والاعدادات ومنها تقرير المبيعات بالفترة شهري ربع سنوي - يومي - صنف معين - عميل معين - رقم الفاتورة - اجل - نقدي تقارير عديدة متنوعة تقرير المشتريات ونفسه تقارير المورين وبها تقارير بالمدة وبالمورد بحالة الدفع شاشة المستخدمين ومنها التحكم في المستخدمين والصلاحيات خيار دخول المستخدمين وقت الدخول والخروج والتاريخ واسم الجهاز التي تم من عليه الدخول اتمني يكون القالب فيه الفايدة والمنفعة مع ملاحظة القالب لا يحتوي الا علي اكواد شاشة الدخول والانتقال بين الخيارات القالب بالمرفقات وبالتوفيق للجميع Business Application Final Officana.xlsm
    1 point
  19. تم معالجة الأمر مع تغيير بسيط في تصميم اليوزر New_UNIQ_DATA.xlsm
    1 point
  20. تفضل أخي اخي laggari طالما وأنت لم توضح الطلب بشكل مفصل فأتمنى أن يفيدك هذا الملف https://drive.google.com/file/d/1SsJvZlvtYrDmGbLOjVYPLvzWpgRMtcVM/view وعليك مراجعة الشرح عبر الرابط التالي وأتمنى أن يستفيد منه الجميع
    1 point
  21. تفضل هذا ملف ممتاز لأستاذنا الكبير إبراهيم الحداد به ما تطلب كما يمكنك مشاهدة هذا الرابط https://www.officena.net/ib/topic/83108-اظهار-البيانات-بأول-حرف/?tab=comments#comment-528783 بحث بحرف.xlsm
    1 point
  22. بارك الله فيك استاذ سليم وكما نصحك اخى الكريم استاذنا الكبير سليم فلابد دائما ان تقوم برفع ملف وتوضيح عليه المطلوب وهذه معادلة اخرى بجانب المعادلة الرائعة للأستاذ سليم -وذلك لإثراء الموضوع =LOOKUP(2,1/((A1:A1000<0)),A1:A1000)
    1 point
  23. لا تقلق من هذه الرسالة فقط عليك بإزالة علامة الصح ثم الضغط على Continue
    1 point
  24. أحسنت استاذ بن علية عمل ممتاز بارك الله فيك
    1 point
  25. السلام عليكم الملف المرفق (فهرس) أدناه يتضمن النتائج المطلوبة فعند كتابة اسم الزبون تظهر النتائج ارجو ادراج معادلة أو كود يعمل على ترحيل الكود واسم الزبون من الملفات الى الفهرس وعند الضغط على الاسم أو الكود يذهب الى الملف المطلوب حملت جزء من الملفات والشيتات (حذفت بعض الشيتات ابقيت المطلوب لهذا العمل لسهولة التحميل) فهرس.rar
    1 point
  26. أخي الكريم أبو يوسف لم يتم الرد للآن وتأكيد الطلب (ورغم أنني من أنصار عدم تقديم المساعدة إلا إذا توافر الشرح الكافي للطلب بالتفصيل ولكن ما باليد حيلة) سأقوم بطرح ما قام به أخونا الحبيب مختار عن طريق الأكواد بعيداً عن معادلات الصفيف .. الآن تم دمج الطلبات بشكل مبدئي ..الجزء الأول تحدد الملفات المراد تجميعها ثم يتم تجميعها كل ملف أو مصنف في ورقة عمل ، ثم الجزء الثاني يتم استخراج مكاتب التربية الغير مكررة في العمود M وفي العمود المقابل له عدد هذه المكاتب ... إذا كان للطلب بقية فأفضل أن يكون في كود منفصل .. حتى لا نتوه بين أسطر الأكواد .. إليك الكود بالشكل النهائي له Sub CollectDataFromMultipleWorkbooks() Dim OpenFiles Dim crntfile As Workbook Set crntfile = Application.ActiveWorkbook Dim X As Integer Dim SH As Worksheet Dim Arr, Temp, I As Long, J As Long, P As Long Dim Rng As Range, ColFound Dim Data As Variant Dim Obj As Object On Error GoTo ErrHandler Application.ScreenUpdating = False OpenFiles = Application.GetOpenFilename(FileFilter:="Microsoft Excel Files (*.csv;*.xlsx;.xlsm),*.csv;*.xlsx;*.xlsm", MultiSelect:=True, Title:="Select Excel File To Merge!") If TypeName(OpenFiles) = "Boolean" Then MsgBox "You Need To Select At Least One File" GoTo ExitHandler End If X = 1 While X <= UBound(OpenFiles) Workbooks.Open Filename:=OpenFiles(X) Sheets().Move After:=crntfile.Sheets(crntfile.Sheets.Count) X = X + 1 Wend For Each SH In ThisWorkbook.Sheets With SH If .Name <> "Master" Then Arr = .Range("A1").CurrentRegion.Value For I = 1 To UBound(Arr) Temp = Split(Arr(I, 1), ";") For J = 1 To UBound(Temp) .Cells(I, J) = Temp(J) Next J Next I .Range("A1").CurrentRegion.Columns.EntireColumn.AutoFit ColFound = Application.Match("*مكتب التربية*", .Rows(1), 0) If IsNumeric(ColFound) Then With .Columns("M:N") .ClearContents .Borders.LineStyle = xlNone .Interior.Color = xlNone End With .Range("M2:N2") = Array("مكتب التربية", "العدد") Set Rng = .Range(.Cells(2, ColFound), .Cells(.Cells(Rows.Count, ColFound).End(xlUp).Row, ColFound)) Set Obj = CreateObject("scripting.dictionary") Data = Rng For P = 1 To UBound(Data) Obj(Data(P, 1) & "") = "" Next .Range("M3:M1000").ClearContents .Range("M3").Resize(Obj.Count, 1) = Application.Transpose(Obj.keys) With .Range("N3:N" & .Cells(Rows.Count, "M").End(xlUp).Row) .Formula = "=COUNTIF(" & Rng.Address & ",M3)" .Value = .Value End With With .Range("M2").CurrentRegion .Range("A1:B1").Interior.Color = vbYellow .Borders.Weight = xlThin .BorderAround Weight:=xlThick .Columns.AutoFit End With End If End If End With Next SH ExitHandler: Application.ScreenUpdating = True Exit Sub ErrHandler: MsgBox Err.Description Resume ExitHandler End Sub تقبل تحياتي Collect Data From Multiple CSV Workbooks Mokhtar V2.rar
    1 point
  27. أخي الكريم دربالة يرجى تغيير اسم الظهور للغة العربية ومراجعة التوجيهات في الموضوعات المثبتة في صدر المنتدى إليك الملف بعد تعديله ليتناسب مع الأوفيس 2013 64 بت UserForm TextBox MaxLength Dahy.rar
    1 point
  28. أتمنى من الله أن تكونوا جميعا في تمام الصحة والعافية وإن شاء الله موضوع اليوم يكون جديد وخفيف وسهل التطبيق ومفيد للبعض على الأقل الفكرة : هي جعل اليوزر فورم شفاف مع إمكانية التحكم في درجة الشفافية بما يتناسب مع إحتياجاتنا والفائدة من هذا هو التنوع في شكل اليوزرفورم وأيضا يمكن أن يكون مفيدا بأنك تستطيع رؤية المحتوى خلف اليوزفورم بدون أن تضطر إلى تحريكه خاصة في اليوزرفوم ذو الأبعاد الكبيرة. طريقة التطبيق: بعد تصميم اليوزفورم أو أي يوزر فورم حالي يتم الدخول إلى الكود الخاص باليوزرفوم كليك يمين على الفورم ثم View Code ثم نقوم بلصق الكود التالي في أعلى كود اليوزفورم قبل أي أكواد أخرى Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function SetLayeredWindowAttributes Lib "user32" _ (ByVal hWnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Private Const GWL_EXSTYLE = (-20) Private Const WS_EX_LAYERED = &H80000 Private Const LWA_ALPHA = &H2& Public hWnd As Long ثانيا في Userform Initialize يتم نسخ وضع الكود التالي هكذا: Private Sub UserForm_Initialize() Dim bytOpacity As Byte bytOpacity = 190 ' يمكنك تغيير درجة الشفافية بالتغيير ما بين القيم 0 إلى 255' hWnd = FindWindow("ThunderDFrame", Me.Caption) Call SetWindowLong(Me.hWnd, GWL_EXSTYLE, GetWindowLong(Me.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED) Call SetLayeredWindowAttributes(Me.hWnd, 0, bytOpacity, LWA_ALPHA) End Sub ودمتم في رعاية الله يوزرفورم شفاف.rar
    1 point
  29. السلام عليكم ورحمة الله تعالى وبركاته أقدم لكم هذه الهدية البسيطة والمتواضعه وهي عبارة عن فورم لمعرفة رموز الالوان RGB color codes chart صورة الفورم وفي الأخير اتمنى هذا العمل ان ينال إعجابكم في إنتظار أرائكم وإقتراحاتكم تقبلو خالص تحياتي RGB color.rar
    1 point
  30. أخى الفاضل تفضل الملف المرفق تمت اضافة الكود للملف الخاص بك تحياتي امر صرف المالية 2015 (1).rar
    1 point
  31. السلام عليكم خلية التاريخ "M11" خلية الوقت "N11" =CONCATENATE(TEXT(M11;"yyyy/mm/dd");" ";TEXT(N11;"[$-2000409]h:mm AM/PM;@"))
    1 point
  32. اخي الكريم بالمرفقات الملف بعد التعديل تم اضافة كود عدم تحريك الفورم وعدم اعلاقه الا من زرClose واضافة زر (Exit) للحفظ والخروج من الاكسيل UserForm TextBox MaxLength.rar
    1 point
  33. أخى ابراهيم بارك الله فيك ولكن HIDE تعمل على اخفاء الفورم فقط من على الشاشة ولكنة يظل فى الذاكرة كما هو أما UNLOAD تقوم باغلاق الفورم نهائيا من على الشاشة والذاكرة أيضا
    1 point
×
×
  • اضف...

Important Information