حسونة حسين

بارك الله فيك وجعله الله في ميزان حسناتك يوم القيامة 

السلام عليكم وبها نبدا

ارفق ملف اخي ليتم فهم طلبك

2 ساعات مضت, matrex 300 said:

مطلوب من الكود هو ان يقوم بتعديل هوامش footer تلقائيا طبقا لعدد الصفح الموجود بالشيت عند الطباعة

هذه مفهومة

2 ساعات مضت, matrex 300 said:

ويكون بعد اخر سطر في الصفحة الاخيرة وفي نهاية الصفحة في باقي الصفحات

هذه ليست مفهومة

هذه معادله @أ / محمد صالح

=IF(C7/360>5;75+(CEILING(C7/360;1)-5)*30;CEILING(C7/360;1)*15)

والثانيه

=IF(C7/360>5;75+(CEILING(C7/360;1)-5)*30;CEILING(C7/360;1)*15)*C3/30

وعليكم السلام ورحمه الله وبركاته

تفضل جرب هذا التعديل

دفتر اليوميه كمال.علي محمد على.xlsx

وعليكم السلام ورحمة الله وبركاته 

الملف به مشاكل وهذا ما استطعت الحصول عليه

test.xlsx

السلام عليكم ورحمة الله وبركاته

ارفق ملف حتى لا يتم غلق الموضوع

وعليكم السلام ورحمة الله وبركاته 

اعتقد ان طلبك ليس له حل 

لو كان لحمايه ورقه العمل فالاكواد موجوده كثيره في المنتدى 

وعليكم السلام ورحمة الله وبركاته 

استبدل الفاصله ,

بالفاصلة المنقوطة ;

هذا الموضوع مخالف لقوانين المنتدي

××××××××

تكرار الموضوع
××××××××
يغلق
××××××××

هذا الموضوع مخالف لقوانين المنتدي

××××××××

انتهاك حقوق الملكيه
××××××××
يغلق
××××××××

السلام عليكم ورحمة الله وبركاته وبها نبدأ 

اخى @الشافعي 

ارفق ملف للعمل عليه

وعليكم السلام ورحمة الله وبركاته 

بارك الله فيك اخى @ابوحبيبه وجعله الله في ميزان حسناتك يوم القيامه

السلام عليكم ورحمة الله وبركاته وبها نبدأ 

اضغط على (لا)

ستظهر نافذه مثل هذه

اختر الامتداد xlsm او xlsb

وعليكم السلام ورحمة الله وبركاته 

اخى ارفق ملفك

في 7‏/10‏/2023 at 09:13, هانى محمد said:

فالمشكلة الأصلية بالملف عند لصق بيانات جديدة يومياً يكون ثقيل جداً ويأخذ وقت كبير حتى اتمام عملية اللصق والإنتهاء منها !

كما ترى أستاذنا الكريم كل هذا الوقت أثناء عملية لصق البيانات

اين يتم لصق البيانات اخى هانى؟

وعليكم السلام ورحمه الله وبركاته

ضع هذا السطر في ثانى سطر في اليوزرفورم

Public Sh As Worksheet

ضع هذه الاسطر في السطر الثالث او اي مكان اخر كما تشاء

Private Sub OptionButton1_Click()
Set Sh = ThisWorkbook.Worksheets(OptionButton1.Caption)
End Sub
Private Sub OptionButton2_Click()
Set Sh = ThisWorkbook.Worksheets(OptionButton2.Caption)
End Sub
Private Sub OptionButton3_Click()
Set Sh = ThisWorkbook.Worksheets(OptionButton3.Caption)
End Sub

قم باستبدال كلمه Sheet1 بكلمة Sh في جميع اكواد اليوزر فورم

6 ساعات مضت, هانى محمد said:

لماذا لا يرحل هذا الكود كما كان يقوم الكود القديم

شغل الكود اخى هاني سوف يجلب البيانات في العامود g والعامود h بدلا من المعادله

الكود ليس له علاقه باي اكواد اخري

وعليكم السلام ورحمة الله وبركاته

بارك الله فيك استاذنا الغالي ابو البراء

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

وعليكم السلام ورحمه الله وبركاته

تفضل اخى @هانى محمد

Option Explicit
Sub Test()
    Dim WS As Worksheet, SH As Worksheet, Lr As Long, i As Long, A, B, C, D, E As Long, WF As Object
    Set WS = ThisWorkbook.Worksheets("Setting")
    Set SH = ThisWorkbook.Worksheets("Main")
    Lr = SH.Cells(Rows.Count, 1).End(xlUp).Row
    ReDim arr(3 To Lr, 1 To 2)
    For i = 3 To Lr
        A = Application.Match(SH.Range("B" & i), WS.Columns("a"), 0)
        If Not IsError(A) Then
            B = Application.Match(SH.Range("C" & i), WS.Columns("BB"), 0)
            If Not IsError(B) Then
                C = Application.Match(SH.Range("F" & i), WS.Rows(1), 0)
                If Not IsError(C) Then
                    If SH.Range("F" & i) = "Marsa Alam" Or SH.Range("F" & i) = "Cairo" Then
                        E = 8
                    Else
                        E = 9
                    End If
                    D = Application.Match(SH.Range("e" & i), WS.Range(WS.Cells(2, C), WS.Cells(2, C + E)), 0) - 1
                    If Not IsError(D) Then
                        arr(i, 1) = WS.Cells(A, C + D)
                        arr(i, 2) = WS.Cells(A, C + D + 1)
                    End If
                End If
            End If
        End If
    Next i
    SH.Range("G3").Resize(UBound(arr, 1) - 2, UBound(arr, 2)).Value2 = arr
End Sub

هذا الموضوع مخالف لقوانين المنتدي

××××××××

موضوع مكرر
××××××××
يغلق
××××××××

اخي mahmoud_nasr

يرجي تعديل اسمك باسم مناسب

وليس كما هو موجود بالاسم @عمل قائمة منسدلة مفلترة تقرأ من

السلام عليكم وبها نبدأ

تفضل كود التعديل

Private Sub CommandButton4_Click()
    Dim SH As Worksheet, X, I As Long
    Set SH = ThisWorkbook.Worksheets("كي جي1")
    If TextBox1.Value = "" Then MsgBox "من فضلك ادخل الاسم الذي تريد البحث عنه يا عم سعد", vbCritical, "تنبيه يا عم سعد": Exit Sub
    X = Application.Match(Val(TextBox1.Value), SH.Columns("C"), 0)
    If Not IsError(X) Then
        For I = 1 To 10
            SH.Cells(X, I + 2).Value = Controls("TextBox" & I).Value
        Next I
        SH.Range("M" & X).Value = openpic
    Else
        MsgBox "الاسم غير موجود"
    End If
End Sub

السلام عليكم وبها نبدأ

ارفق ملف اخى @UNFOOAAN

جزاكم الله خيرا اخى ابو يوسف @محمد حسن المحمد

جزاكم الله خيرا اخي @محمد يوسف ابو يوسف

جزاكم الله خيرا علي التنبيه

وهذا نص تقرير اخى ابو يوسف محمد حسن المحمد جزاه الله خيرا

السلام عليكم ورحمة الله وبركاته

إخوتي أساتذتي الكرام: تحية طيبة وبعد أرى أن هذا الموضوع وإن كان في ظاهره يخص سؤال أو أكثر في الإكسل،إلا أنه في حقيقة الأمر

يفتح باباً واسعاً لما لا يرضي الله وهو ما يخالف برأيي منهجنا كمسلمين

الاوفيس الذي قمت بتنصيبه ٦٤ بت

قم بحذفه وتنصيب اوفيس ٣٢ بت ليتوافق مع ملفك