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

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

  1. Ali Mohamed Ali

    Ali Mohamed Ali

    أوفيسنا


    • نقاط

      173

    • Posts

      11,084


  2. Mohamed Hicham

    Mohamed Hicham

    03 عضو مميز


    • نقاط

      97

    • Posts

      260


  3. AbuuAhmed

    AbuuAhmed

    الخبراء


    • نقاط

      86

    • Posts

      157


  4. jjafferr

    jjafferr

    أوفيسنا


    • نقاط

      66

    • Posts

      9,119


Popular Content

Showing content with the highest reputation since 07 سبت, 2022 in all areas

  1. وعليكم السلام -تفضل بهذه المعادلة سحباً لليسار ثم الى الأسفل =COUNTIFS(data!C$2:C$1000,"<>"&"",data!$A$2:$A$1000,$B4,data!$B$2:$B$1000,1) trasnport1.xlsx
    7 points
  2. :: السلام عليكم ورحمة الله وبركاته :: 🙂 يطيب لي أن أهديكم هذه الهدية البسيطة 🎁 :: مرسال الواتسأب :: وهو برنامج بسيط جدا لإرسال الرسائل عن طريق الواتسأب .. مع إمكانية إرسال المرفقات كذلك ( صور أو مستندات ) 🙂 وله واجهتين رئيسيتين : 1 - الرسائل الفردية 2 - الرسائل الموجهة لعدة أشخاص :: وهذه صور لواجهات البرنامج :: طبعا من الضروري تنصيب برنامج الواتسأب للكمبيوتر وتشغيله قبل تشغيل البرنامج 🙂 وبملاحظاتكم ودعواتكم دوما نرتقي 🙂 :: وأخيرا :: التحميل :: ☺️👌🏼 مرسال الواتسأب.accdb
    6 points
  3. السلام عليكم إخوتي الكرام بعد إذن الأخ الكريم الذي وصل إلى النتيجة ، إليكم طريقة أخرى بمعادلة واحدة فقط =IF(1*TEXT(EOMONTH(TODAY();0);"dd")>30;EOMONTH(TODAY();0)-4-TODAY()&"يوم";IF(1*TEXT(EOMONTH(TODAY();0);"dd")=30;EOMONTH(TODAY();0)-3-TODAY()&"يوم";IF(1*TEXT(EOMONTH(TODAY();0);"dd")=29;EOMONTH(TODAY();0)-2-TODAY()&"يوم";IF(1*TEXT(EOMONTH(TODAY();0);"dd")=28;EOMONTH(TODAY();0)-1-TODAY()&"يوم")))) وهناك معادلة أخرى فقط للملاحظة قد لا يحتاجها الأخ السائل: =" باقي"&$C$5&" "&"بناء على تاريخ نزول الراتب والذي يوافق يوم 27 من كل شهر ميلادي" والله ولي التوفيق ..والسلام عليكم موعد الرواتب.xlsx
    6 points
  4. السلام عليكم 🙂 اخي ابو احمد @AbuuAhmed اسمح لي اكون اول من يُهنّيك على الترقية 🙂 هي مجرد القاب للمحترفين ، وتعريف الباقين بكم 🙂 جعفر
    6 points
  5. وعليكم السلام 🙂 كود اخوي موسى ، ولكن بطريقتي 🙂 Sub CopyFile() Dim sPathDeskTop As String sPathDeskTop = Environ("USERPROFILE") & "\Desktop" & "\b\" ' هنا اسم المجلد الذي سيتم انشاؤه في سطح المكتب Dim CopyFrom As String, CopyTo As String CopyFrom = Me.a ' هذا اسم الحقل الذي به رابط الملف المراد نسخه CopyTo = sPathDeskTop & Dir(CopyFrom) If Len(Dir(sPathDeskTop, vbDirectory)) = 0 Then MkDir (sPathDeskTop) If Len(Dir(CopyTo, vbDirectory)) = 0 Then FileCopy CopyFrom, CopyTo Else MsgBox "هذا الملف موجود مسبقا على سطح المكتب", vbOKOnly Exit Sub End If End Sub جعفر
    6 points
  6. وعليكم السلام 🙂 ان شاء الله طريقتي تعجبك 🙂 . . Private Sub VeiwReportBtn_Click() On Error GoTo Err_VeiwReportBtn_Click Dim qry_0 As String, qry_1 As String qry_0 = "Select * From qry_Table2_Empty_One_Record" qry_1 = "Select * From qry_Table2" DoCmd.DeleteObject acQuery, "tqry_SubReport" If DCount("*", "Table2", "T1ID=" & Me.IdCbo) = 0 Then CurrentDb.CreateQueryDef "tqry_SubReport", qry_0 Else CurrentDb.CreateQueryDef "tqry_SubReport", qry_1 End If Dim stDocName As String stDocName = "Report1" DoCmd.OpenReport stDocName, acViewPreview, , "[ID]=" & Me.IdCbo Exit_VeiwReportBtn_Click: Exit Sub Err_VeiwReportBtn_Click: If Err.Number = 7874 Then 'query tqry_SubReport does not exist, ignore Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If Resume Exit_VeiwReportBtn_Click End Sub جعفر 1523.ShowReportInNoDate.accdb.zip
    5 points
  7. طبعا أنا كنت أجرب قبل ما أشوف مشاركة أستاذنا العزيز جعفر 🙂 وهذي محاولتي : طبعا يتم استعراض ملفات ال PDF في المتصفح ( وهذا يتطلب وجود برنامج مشغل PDF ) ويمكن الاستغناء عن العرض الكود يجلب كل الملفات المرتبطة بالرقم المطلوب تلقائيا عند الإنتقال من سجل لآخر في النموذج الفرعي ويجمعها في ليست بوكس .. النقر المزدوج على اسم الملف يفتحه لك خارجيا .. وهذا الكود : Public Sub BringAllFilesAndFolders() Dim path As String, currentPath As String Dim List As ListBox Set List = Forms!tabl1!FileList path = CurrentProject.path & "\Datapdfx\" currentPath = Dir(path, vbDirectory) List.RowSource = "" Do Until currentPath = vbNullString If InStr(currentPath, CStr(Me.noid)) > 0 Then List.AddItem currentPath End If currentPath = Dir() Loop Set List = Nothing End Sub ربط البيانات مع ملف pdf.rar
    5 points
  8. وعليكم السلام 🙂 تفضل: . وهذا يحدث بهذا الكود: Private Sub Form_Current() Dim rst As DAO.Recordset Dim strFile As String Set rst = Me.tabl2.Form.RecordsetClone rst.MoveFirst Me.lst_Files.RowSource = "" Do Until rst.EOF Debug.Print rst!noid Me.lst_Files.AddItem ">" & rst!noid 'Now lets find how many files we have strFile = Dir(Application.CurrentProject.Path & "\Datapdfx\*" & rst!noid & "*.pdf") Do Until strFile = "" Debug.Print strFile Me.lst_Files.AddItem strFile strFile = Dir() Loop Me.lst_Files.AddItem "" rst.MoveNext Loop End Sub Private Sub lst_Files_DblClick(Cancel As Integer) Dim pdfPath As String If Left(Me.lst_Files, 1) = ">" Then Exit Sub pdfPath = CurrentProject.Path & "\Datapdfx\" & Me.lst_Files Shell "explorer.exe " & pdfPath, vbNormalFocus End Sub جعفر dataPdf.zip
    5 points
  9. وعليكم السلام ورحمة الله وبركاته .. تفضل أخي العزيز 🙂 Sub CopyFile() 'Requires reference: :لابد من التأكد من وجود المكتبة الاتية 'Add this reference >>---> Microsoft Scripting Runtime Dim fs Set fs = CreateObject("Scripting.FileSystemObject") Dim sPathDeskTop As String Dim oWSH As Object Set oWSH = CreateObject("WScript.Shell") sPathDeskTop = oWSH.SpecialFolders("Desktop") & "\b\" ' هنا اسم المجلد الذي سيتم انشاؤه في سطح المكتب Dim CopyFrom As String, CopyTo As String CopyFrom = Me.a ' هذا اسم الحقل الذي به رابط الملف المراد نسخه CopyTo = sPathDeskTop & Dir(CopyFrom) If Len(Dir(sPathDeskTop, vbDirectory)) = 0 Then MkDir (sPathDeskTop) If Len(Dir(CopyTo, vbDirectory)) = 0 Then fs.CopyFile CopyFrom, CopyTo, True Else MsgBox "هذا الملف موجود مسبقا على سطح المكتب", vbOKOnly Exit Sub End If Set fs = Nothing Set oWSH = Nothing End Sub فقط انتبه للملاحظات المكتوبة في الكود ..
    5 points
  10. فاجأتوني ، شكرا لكم على الثقة والترقية ، وشكرا لكم جميعا على التهنئة ، وإن شاء الله أكون عند حسن ظنكم دائما.
    5 points
  11. الكود يعمل فقط على مربع النص الخاص بالتخصص انظر الصورة في الرد السابق لي ..... عموما تفضل ملفك بعد التعديل عليه ........ Database1601.accdb
    4 points
  12. السلام عليكم و رحمة الله جرب هذا الكود Sub ConTxtNum() Dim ws As Worksheet, C As Range Dim i As Long, j As Long Dim Arr, Tmp, Txt As String Set ws = Sheets("Sheet1") Application.ScreenUpdating = False For Each C In ws.Range("K6:K" & ws.Range("K" & Rows.Count).End(3).Row) For i = 1 To Len(C) Txt = Mid(C, i, 1) If Txt Like "[0-9]" Or Txt = "0" Then Arr = Arr & Txt Else Arr = Arr & " " End If Next Arr = Application.WorksheetFunction.Trim(Arr) Tmp = Split(Arr, " ") For j = 0 To UBound(Tmp) C.Offset(0, j + 2) = Tmp(j) Arr = "" Next Next Application.ScreenUpdating = True End Sub
    4 points
  13. وعليكم السلام ..قم أولاً بتحويل تنسيق الأرقام إلى رقم لأنها منسقة على شكل نص من V9:V15 أو اضرب قيمة كل خلية بـ 1 أما القيم الرقمية في العمود .AC9:AE15 استبدل كلمة دائن بفراغ وحوله إلى رقم ..أو استخدم المعادلة التالية: =SUBSTITUTE(AC9;"دائن";"") نموذج اوفيسنا.xlsx
    4 points
  14. تفضل اخي المشكلة في تنسيق الخلايا ليس اكثر تم تعديل الملف اطفال_MH-3.xlsm
    4 points
  15. السلام عليكم ورحمة الله تعالى وبركاته نعم اخي الفاضل اتضحت الفكرة وللعلم اخي الفاضل استوعاب الفكرة وفهم المطلوب يمثل 90 في المئة من الحل .وهدا ما يجعلني لا اخوض في كثير من المداخلات بسبب عدم شرح السائل لطلبه جيدا او وضع نمودج للنتائج المتوقعة . على العموم اتمنى ان اكون قد استوعبت طلبك اخي الكريم 😁 اليك كودين ولك الاختيار هدا كود لنقل البيانات من الاعمدة الى الصفوف حسب الرمز المكرر من شيت اطفال الى شيت اخر (DATA ) Sub Transpose_to_columns() Dim inp_arr, i As Long, out_arr, dict As Object, key As String Set dict = CreateObject("Scripting.Dictionary") With Sheets("اطفال") inp_arr = .Range(.Cells(2, 5), .Cells(.Rows.Count, 1).End(xlUp)).Value End With For i = 1 To UBound(inp_arr) key = CStr(inp_arr(i, 1)) If dict.Exists(key) Then dict(key) = dict(key) & ";" & inp_arr(i, 3) & ";" & inp_arr(i, 4) & ";" & inp_arr(i, 5) Else dict.Add key, inp_arr(i, 3) & ";" & inp_arr(i, 4) & ";" & inp_arr(i, 5) End If Next i ReDim out_arr(1 To dict.Count, 1 To 4) For i = 0 To dict.Count - 1 out_arr(i + 1, 1) = dict.Keys()(i) out_arr(i + 1, 2) = dict.Items()(i) Next i With Sheets("data") .Cells(2, 1).Resize(dict.Count, 2) = out_arr .Cells(2, 2).Resize(dict.Count, 1).TextToColumns Destination:=.Cells(2, 2), DataType:=xlDelimited, Semicolon:=True End With Set dict = Nothing Sheets("data").Activate End Sub وهدا كود لنقل البيانات من الاعمدة الى الصفوف حسب الرمز المكرر في نفس الشيت (اطفال) Sub MH_transpose_colmns() Dim der, t, ref, nbr&, i&, i1&, i2& Application.ScreenUpdating = False With ActiveSheet If .FilterMode Then .ShowAllData der = Cells(Rows.Count, "a").End(xlUp).Row Columns("a:e").Resize(der).Sort key1:=Range("a1"), order1:=xlAscending, _ key2:=Range("b1"), order2:=xlAscending, Header:=xlYes t = Columns("a:e").Resize(der + 1).Value2 ReDim r(1 To 1, 1 To Columns.Count - Range("h1").Column - 1) Range(Range("h1"), Cells(Rows.Count, Columns.Count)).Clear ref = t(2, 1): i1 = 2: i2 = i1: nbr = 1: r(1, nbr) = ref Do If t(i2, 1) = ref Then nbr = nbr + 1: r(1, nbr) = t(i2, 3) nbr = nbr + 1: r(1, nbr) = t(i2, 4) nbr = nbr + 1: r(1, nbr) = t(i2, 5) i2 = i2 + 1 Else Cells(Rows.Count, "h").End(xlUp).Offset(1).Resize(, nbr) = r ReDim r(1 To 1, 1 To Columns.Count - Range("h2").Column - 1) i1 = i2: i2 = i1: ref = t(i2, 1): nbr = 1: r(1, nbr) = ref If ref = "" Then Exit Do End If Loop End With Application.ScreenUpdating = True End Sub واليك الملف مع اضافة الاكواد ....في حالة الرغبة في الاضافة او التعديل لا تتردد اخي الكريم.بالتوفيق ... اطفال_MH.xlsm
    4 points
  16. 4 points
  17. جزاك الله خسر الثواب وأكرمك الله وأحسن الله اليك
    4 points
  18. أحسنت أستاذنا الكريم وبارك الله فيك .. طبعاً موضوع مهم وقيم , جعله الله فى ميزان حسناتك
    4 points
  19. 4 points
  20. 4 points
  21. وعليكم السلام ..بما انك لم تقم برفع ملف ,,فكان عليك استخدام خاصية البحث بالمنتدى فطلبك تكرر كثير جداً وشوف بنفسك : وده كمان مثال بملف مرفق لك وكلمة السر لإظهار الصفحات : 123 اخفاء الشيتات و ترك الشيت الرئيسي هو الظاهر كود اخفاء الشيتات عدا شيت محدد اخفاء الصفحات تلقائيا اخفاء أوراق العمل وعدم اظهارها فورم_كود اظهار و اخفاء للصفحات Sheets Hidding - 2.xlsm
    4 points
  22. وعليكم السلام أهلاً بك فى المنتدى -تفضل لك ما طلبت ويجب عليك اتباع الخطوات كما بالصورة حدود الصفحة.xlsm
    4 points
  23. يمكنك استخدام هذه المعادلة لطلبك ..معادلة مصفوفة (Ctrl+Shift+Enter) =IFERROR(INDEX(Table2[التاريخ],SMALL(IF(Table2[اسم الموقع/ المخزن]=$C$3,ROW($A$4:$A$11)-ROW($A$4)+1),ROWS(A$1:A1))),"") كشف حساب مشروع1.xlsx
    4 points
  24. وكذلك كود اخوي موسى بطريقتي : If Len(Me.nox & "") = 0 Then Exit Sub جعفر
    4 points
  25. فقط يمكنك استخدام هذه المعادلة أو بعمل تنسيق للخلايا بأن يكون تنسيق الخلية يوم وليس تاريخ B2dddd =TEXT(B3,"b2dddd") هاجر البصمة1.xlsx
    4 points
  26. السلام عليكم قبل البدء انت محتاج تغير ال listbox اللى قدام الكود الى combobox وليكن combobox2 اولا انت محتاج تملا الكمبو بوكس مع بداية عمل الفورم Private Sub UserForm_Initialize() Dim LR As Long With Sheets("update 2022 September") LR = .Range("A" & .Rows.Count).End(xlUp).Row Me.ComboBox2.RowSource = "=$A$4:$A$" & LR Me.ComboBox1.RowSource = "=$C$4:$C$" & LR End With End Sub كده انت ملأت الاتنين الكمبوبوكس يبقى انت محتاج كود عند تغيير الكمبوبوكس Private Sub ComboBox2_Change() ComboBox1.ListIndex = ComboBox2.ListIndex If ComboBox2.ListIndex <> -1 Then TextBox3.ControlSource = "=$H$" & ComboBox2.ListIndex + 4 Else TextBox3.ControlSource = "" TextBox3.Text = "" End If End Sub وبكده التكست بوكس اصبحت مرتبطه بالخليه يعنى اي تغيير فيها ها يتحدث اتوماتيتك فى الخليه * الجمله الشرطية للتأكد انك كتبت كود موجود داخل الليست , , والا يلغى ارتباط التكست بوكس بالخلية ثم يمسح محتوى التكست بوكس * ال 4 دي بداية اول سطر بيانات فى الجدول
    4 points
  27. تفضل التعديل أخي m.r 🙂 Sub CopyFile() Dim sPathDeskTop As String sPathDeskTop = Environ("USERPROFILE") & "\Desktop" & "\b\" ' هنا اسم المجلد الذي سيتم انشاؤه في سطح المكتب Dim CopyFrom As String, CopyTo As String CopyFrom = Me.SourceFilePath ' هنا تضع اسم الحقل الذي به رابط الملف المراد نسخه CopyTo = sPathDeskTop & Me.NewFileName & ".pdf" ' هنا تضع اسم الحقل الذي به اسم الملف الجديد وامتداده If Len(Dir(sPathDeskTop, vbDirectory)) = 0 Then MkDir (sPathDeskTop) If Len(Dir(CopyTo, vbDirectory)) = 0 Then FileCopy CopyFrom, CopyTo Else MsgBox "هذا الملف موجود مسبقا", vbOKOnly Exit Sub End If End Sub
    4 points
  28. لا اتفق معك استاذنا العزيز طاهر مثلا الان نحن في شهر 9 ميلادي 2 هجري لو حولت التاريخ وفقا لما صنعت سيكون الميلادي 2022 والهجري 1444 وهذا تمام جزئيا لكون الاشهر الستة الاولى من شهر 2022 توافق العام 1443 بعد اربعة اشهر يكون الميلادي 2023 والهجري وفقا لعملك 1445 وهذا غير صحيح لكوننا مازلنا في الشهر السادس 1444 ايضا جزء من عام 2024 سيكون ضمن العام الهجري 1445 والعام 1446 وعام 2025 سيكون ضمن العام 1446 والعام 1447 هجري ايضا العام 2030 بحسابك سيكون 1453 بينما يفترض ان يكون 1451 والعام 1452 اعتقد ان العمل يحتاج الى اعادة النطر والتحويل بالسنة بدون اليوم والشهر لن يعطي النتيجة المطلوبة رأي شخصي غير ملزم
    4 points
  29. تفضل اخي Sub MH_copy() Dim i As Long Application.ScreenUpdating = False With Cells(1).CurrentRegion For i = 2 To .Rows.Count Step 6 lastro = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row + 1 .Rows(i).Resize(6).Copy Range("c" & Rows.Count).End(xlUp)(2).PasteSpecial Transpose:=True Next End With If Range("c3").Value <> "" Then Range("C2:h" & lastro).Select With Range("C2:h" & lastro).Borders.LineStyle = xlNone Range("C2:h" & lastro).Borders.LineStyle = xlContinuous Range("a1").Select Application.ScreenUpdating = True End With End Sub 1.xlsm
    4 points
  30. بارك الله فيك وزادك الله من فضله
    4 points
  31. وعليكم السلام استاذنا ابو البشر امر محزن ان يتم اغلاق اي موقع تعليمي مع اني لست من رواد ذلك الموقع ولكن اغلاق المنتديات امر متوقع وسيتبعه مواقع اخرى لاسباب عديدة منها وبدون الدخول في التفاصيل برامج ومواقع التواصل الاجتماعي سحبت البساط عدم وجود تطبيقات محترفة للمنتديات على الهواتف والاجهزة اللوحية اغلب المنتديات العربية تدار بشكل فردي وليس مؤسسي برامج المنتديات وان تطورت من ناحية الاكواد والحماية الا انها مازالت بنفس القالب منذ اول اصدار اغلب مواضيع المنتديات نسخ ولصق وتوجد اسباب اخرى ولكني اكتفي بما سبق
    3 points
  32. طيب ادخل على تفصيل النموذج ..... حدث عند الطباعة وادرج الكود التالي .... Dim ctl As Control, strText As Variant, strName As String Me.ScaleMode = 1 For Each ctl In Me.Detail.Controls If ctl.ControlType = acTextBox And ctl.name = "Text4" Then strName = ctl.name If Nz(ctl.Tag, "") = "" Then ctl.Tag = ctl.FontSize End If ctl.FontSize = ctl.Tag Me.FontSize = ctl.FontSize strText = ctl.Value If Len(strText) > 0 Then Do Until TextWidth(strText) < ctl.Width ctl.FontSize = ctl.FontSize - 1 Me.FontSize = ctl.FontSize Loop Do Until TextHeight(strText) < ctl.Height - (ctl.Height * 0.26) ctl.FontSize = ctl.FontSize - 1 Me.FontSize = ctl.FontSize Loop End If End If Next ctl ثم انظر النتيجة ......................
    3 points
  33. بارك الله فيك استاذنا الكريم وفى جميع مشاركاتك وموضوعاتك القيمة التى نشتاق اليها دائماً .. ونتمنى لكم العودة فى أقرب وقت الى بيتك وبالطبع سنكون جميعاً سعداء بعودتكم ومرحب بكم فى أى وقت وشكراً لكم على جهودكم المفيدة بالمنتدى ونتمنى لكم النجاح والتفوق دائماً فى حياتكم وبارك الله فيكم وأحسن الله اليكم وأكرمك الله
    3 points
  34. لديك الآن 4 خيارات عن طريق الأزرار/الضغطات في صفحة المسودة ..موفقين. كود توزيع القرار_12.xlsm
    3 points
  35. هنا الاستاذ العزيز احمد قام بتعديل نوع الحقل الى نص والامور تمام طيب لو اردنا بقاء الحقل كماهو تاريخ وقت واظهار اليوم Me.Zday = [Zdate] ثم في خصائص الحقل zday تنسيق نضع dddd الملف مرفق تاريخ.accdb
    3 points
  36. وعليكم السلام ورحمه الله وبركاته اتفضل تم تعديل حقل zday فالجدول لنص ليقبل اسم اليوم Me.Zday = Format(Me.Zdate, "dddd") بالتوفيق تاريخ.accdb
    3 points
  37. السلام عليكم ورحمة الله اخى الكريم الكود يقوم بمسح البيانات حتى الصف رقم 49 ..سيتم رفع الملف بعد التعديلات لصعوبة تطبيقها بنفسك قوائم.xlsm
    3 points
  38. يمكنك ذلك بهذه المعادلة =INDEX($C$17:$R$24,MATCH($F$5,$B$17:$B$24,0),MATCH($J$5,$C$15:$R$15,0)) 1اسعار العملات.xlsx
    3 points
  39. جرب هذا الملف ..اذا تم كتابة اسم الورقة خطا ستظهر لك رسالة تجنبا لاي خطا بالكود لا تحتاج الى زر للورقة الاولى الازرار للاوراق الاخرى عند الرجوع للصفحة الرئيسية . ACTIVATION.xlsm
    3 points
  40. السلام عليكم و رحمة الله اجعل الكود هكذا Sub y() Dim sumRange As Range, criteriaRange As Range Dim result As Double Dim i As Integer Dim lastrow As Long Dim R As Range Dim criteria As Variant Set criteriaRange = Range("D4:D20") criteria = Array("اجمالي صنف1", "اجمالي صنف2") j = 1 Do While j <= 6 Set sumRange = Range("E4:E20").Offset(0, j - 1) For i = 0 To UBound(criteria) result = WorksheetFunction.Sum(result, WorksheetFunction.SumIfs(sumRange, criteriaRange, criteria(i))) Set R = ActiveSheet.Cells.Find("اجمالي الأصناف", , xlValues, xlWhole) If Not R Is Nothing Then R.Select ActiveCell.Offset(0, j).Select ActiveCell.Value = result Next i result = 0 j = j + 1 Loop Range("D3").Activate End Sub
    3 points
  41. تفضل اخي تم تعديل الملف ليتناسب مع طلبك مع بعض الاضافات البسيطة اتمنى ان تلبي المطلوب بادن الله Sub Copie_Sheets_Numérotée_MH() Dim Ind As Integer Dim FlgExist As Boolean, Test As String Application.ScreenUpdating = False Sheet3.Copy After:=Sheets(Sheets.Count) Ind = 2 Do On Error Resume Next Test = Sheets("hakan" & Ind).Range("A1").Value If Err.Number = 0 Then FlgExist = True: Ind = Ind + 1 Else FlgExist = False Loop While FlgExist On Error GoTo 0 ActiveSheet.Name = "hakan" & Ind Sheet2.Select Application.Calculation = xlAutomatic Application.ScreenUpdating = True End Sub mango_MH3.xlsm
    3 points
  42. حياك الله أخي حامل المسك 🙂 ضع هذا السطر في أول الكود .. If IsNull(Me.nox) Or Me.nox = "" Then Exit Sub
    3 points
  43. الحمد لله،، ثم الحمد لله.. المبدعون الكرام.. @jjafferr @Moosak تقف الكلمات حائرة.. أمام جميل تعاونكم البناء وأخوتكم الكريمة.. تلاقت الأرواح بكل جمال ومحبة وصدق وتعاون.. فلكم منا صادق الدعاء فلقد أجدتم ونفعتم وكفيتم ووفيتم.. والحمد لله ضبطت الطريقة.. فشكر الله شكرا عظيما وجزاكم خير الجزاء وبارك لكم فيما رزقكم وجعل ما جدتم به رفعة لكم في الدنيا والآخرة..
    3 points
  44. وعليكم السلام 🙂 اجعل اسم الزر cmd_clear_fields ، ثم ضع الكود في حدث النقر على الزر: Private Sub cmd_clear_fields_Click() On Error GoTo err_cmd_clear_fields_Click Dim ctl As Control For Each ctl In Me.Controls If ctl.ControlType = acTextBox Or ctl.ControlType = acComboBox Then If ctl.Name <> "g1s11" And _ ctl.Name <> "g1s12" And _ ctl.Name <> "g1s13" And _ ctl.Name <> "g1s14" And _ ctl.Name <> "g1s15" Then ctl.Value = "" End If End If Next Exit_cmd_clear_fields_Click: Exit Sub err_cmd_clear_fields_Click: If Err.Number = 2448 Then 'can't change autonumber Resume Next ElseIf Err.Number = 3314 And ctl.Name = "g1s3" Then 'a date must be entered ctl.Value = Date Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If Resume Exit_cmd_clear_fields_Click End Sub جعفر up.zip
    3 points
  45. كان عليك استخدام خاصية البحث بالمنتدى قبل طرح مشاركتك فبه طلبك -تفضل https://www.officena.net/ib/search/?&q=تفقيط مساحة&search_and_or=and&sortby=relevancy
    3 points
  46. شكرا اخوي موسى 🙂 وهذا رابط أخر ، فيه شرح يخص الاستعلام : جعفر
    3 points
  47. ألف مبروك على التهنئة وبالتوفيق والنجاح دائماً
    3 points
  48. اخوانى الكرام الملف يعمل عندى وهذه صورة الواجهة وسأرسل الملف مرة اخرى برنامج اجازات الموظفين.xlsm
    3 points
  49. وعليكم السلام لقد تم الحل من قبل استاذنا الكبير ياسر خليل فورمة بحث في الشيتات - اظهار المراحل لاختصار طبع الفاتورة.xlsm
    3 points
×
×
  • اضف...

Important Information