اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

أبو حنف

02 الأعضاء
 عرض الملف الشخصي  عرض المشاركات

  • Posts

    88

  • تاريخ الانضمام

  • تاريخ اخر زياره

 نوع المحتوي 

مشاركات المكتوبه بواسطه أبو حنف

    عمل حلقة تكرارية للأكواد

    في منتدى الاكسيل Excel

    قام بنشر · تم تعديل بواسطه أبو حنف

    السلام عليكم اخواني 

    المطلوب

    1- عمل حلقة تكرارية للأكواد في الفورم
    2- كود تسمية تشيك بوكس تلقائيا باسم رأس كل عامود مع ترتيهم رأسيا بشكل منتظم أو كود يقوم بالانشاء والتسمية والترتيب تلقائيا في حدث الفورم 
    Private Sub CheckBox1_Click()
' أهنا الكود الأول خاص بوضع صح كل التشيك بوكس الموجود في الفورم أو ازالة الصح وأريد الحلقة حتي تشيك بوكس 15 مثلا 
If CheckBox1 = False Then
CheckBox2.Value = False
CheckBox3.Value = False
CheckBox4.Value = False
CheckBox5.Value = False
CheckBox6.Value = False

ElseIf CheckBox1 = True Then
CheckBox2.Value = True
CheckBox3.Value = True
CheckBox4.Value = True
CheckBox5.Value = True
CheckBox6.Value = True
End If
End Sub

Private Sub CheckBox2_Click()
'هنا الكود الثاني خاص بكل تشيك بوكس على حدة وأريد الحلقة حتي تشيك بوكس 15مثلا
If CheckBox2 = False Then
Columns(2).Hidden = True
ElseIf CheckBox2 = True Then
Columns(2).Hidden = False
End If
End Sub

Private Sub CheckBox3_Click()
If CheckBox3 = False Then
Columns(3).Hidden = True
ElseIf CheckBox3 = True Then
Columns(3).Hidden = False
End If
End Sub

Private Sub CheckBox4_Click()
If CheckBox4 = False Then
Columns(4).Hidden = True
ElseIf CheckBox4 = True Then
Columns(4).Hidden = False
End If
End Sub

Private Sub CheckBox5_Click()
If CheckBox5 = False Then
Columns(5).Hidden = True
ElseIf CheckBox5 = True Then
Columns(5).Hidden = False
End If
End Sub

Private Sub CheckBox6_Click()
If CheckBox6 = False Then
Columns(6).Hidden = True
ElseIf CheckBox6 = True Then
Columns(6).Hidden = False
End If
End Sub

     

    CheckBox.rar

    شرح كود جلب بيانات بناء على قيمة معينة للرائع الأستاذ ياسر خليل أبو البراء

    في منتدى الاكسيل Excel

    قام بنشر

    شكرا أخي ياسر 
    بعد محاولات عديدة وتتبع للخلل وجدت بغيتي

    أنا كنت أبحث عن كلمات وأرقام وكان الخطأ عند البحث بواسطة كلمة ، ولكن بعد حذف "cdb1 " من السطر  حلت المشكلة

    وتم تعديل السطر الى  

    If (.Cells(I, (Range("b1").Value))) = (Range("C1")) Then

    مرفق ملف لمن أراد الاستزادة

    Overtime Report Loop Through All Sheets YasserKhalil 1.rar

    وطلب أخير 
    هل يمكن اختصار الكود من الأسطر والمتغيرات الغير ضرورية لملفي - ان وجدت - لسهولة التعديل بعد ذلك ؟؟

    • Like 2

    شرح كود جلب بيانات بناء على قيمة معينة للرائع الأستاذ ياسر خليل أبو البراء

    في منتدى الاكسيل Excel

    قام بنشر

    باختصار 

    1- كود البحث مبني على القيم الموجودة في أول عامود  لو أردت تغيير عمود البحث فأين يمكنني التغيير ؟

    2- ما فائدة هذا الشرط ؟  

    If CDbl(.Cells(I, 1)) = CDbl(Ws.Cells(1, "C"))

    تم ارفاق الملف 

    Overtime Report Loop Through All Sheets YasserKhalil 1.rar

    شرح كود جلب بيانات بناء على قيمة معينة للرائع الأستاذ ياسر خليل أبو البراء

    في منتدى الاكسيل Excel

    قام بنشر

    هنا الكود 
    ومرفق الملف 

    Option Explicit

'Author : YasserKhalil
'Release : 25 - 08 - 2016

Sub Test()
    Dim Ws      As Worksheet
    Dim Sh      As Worksheet
    Dim I       As Long
    Dim J       As Long
    Dim Lr      As Long
    Dim Last    As Long

    Set Ws = Sheets("Sheet1")
    J = 3

    Application.ScreenUpdating = False
        With Ws.Range("A3:H1000"): .ClearContents: .Borders.Value = 0: End With
        If IsEmpty(Ws.Range("C1")) Then MsgBox "Employee Number Not Existing", vbExclamation: Exit Sub
        
        For Each Sh In ThisWorkbook.Worksheets
            If Sh.Name <> Ws.Name Then
                With Sh
                    Lr = .Cells(Rows.Count, 1).End(xlUp).Row
                    For I = 2 To Lr
                        If Not IsEmpty(.Cells(I, 1)) Then
                            If CDbl(.Cells(I, 1)) = CDbl(Ws.Cells(1, "C")) Then
                                Ws.Cells(J, 1) = Ws.Cells(J, 1).Row - 2
                                Ws.Cells(J, 2).Resize(1, 3).Value = Sh.Cells(I, 3).Resize(1, 3).Value
                                Ws.Cells(J, 5).Value = Sh.Cells(I, 12).Value
                                Ws.Cells(J, 6).Value = Sh.Cells(I, 10).Value
                                Ws.Cells(J, 7).Formula = "=TIME(8,,)"
                                Ws.Cells(J, 8).Formula = "=IF(AND(F" & J & "="""",G" & J & "=""""),"""",IF(F" & J & ">G" & J & ",(F" & J & "-G" & J & "),0))"
    
                                J = J + 1
                            End If
                        End If
                    Next I
                End With
            End If
        Next Sh
    
        If J < 4 Then MsgBox "No Employee With That Number", 64: Exit Sub
    
        Last = IIf(Ws.Cells(Rows.Count, 1).End(xlUp).Row < 3, 2, Ws.Cells(Rows.Count, 1).End(xlUp).Row)
        With Ws.Range("A2:H" & Last): .Borders.Value = 1: End With
    Application.ScreenUpdating = True

    MsgBox "Done...", 64
End Sub

     

    مطلوب كود تسمية commandbutton + اختصار كود

    في منتدى الاكسيل Excel

    قام بنشر

    شاكر ردك أخي أبو عبد الباري 
    ولكن كما قلت تم الاستغناء عن ذلك 
    ولكن لاثراء المعلومات هناك ملاحظتين

    1- هناك أمر لم أجده في الكود وهو يجعل قيمة الخلية c1 تساوي اسم commandbutton

    2- بطريقتك هذه أظن أنني بحاجة ألى كتابة الأمر لكل commandbutton على حدة والمطلوب هو كتابة الأمر مرة واحدة فقط للكل كما في كود التسمية

    مطلوب كود تسمية commandbutton + اختصار كود

    في منتدى الاكسيل Excel

    قام بنشر

    حاضر أخي ياسر
    لكن اعذرني الملف ليس معي الآن 
    وللتوضيح أكثر 
    الفكرة هي أني عندي 30 commandbutton 

    كلهم لهم نفس الأمر وهو تسمية الخلية c1 باسم commandbutton  +فلترة النطاق A$1:$C$38 بدون خلايا فارغة

    أنا أسأل هل فيه كود أستطيع به كتابة الأمر مرة واحدة لكل commandbutton  ، أم لا بد من كتابة الأمر لكل commandbutton  على حدة
    وإن شاء الله أرفع لكم الملف غدا 

    مطلوب كود تسمية commandbutton + اختصار كود

    في منتدى الاكسيل Excel

    قام بنشر

    اخواني

    استفسارين 
    1- أريد معرفة كيف يمكن تسمية عدة commandbutton بالكود بناء على قيم خلايا ؟

    يعني مثلا عندي عدد 30 commandbutton ، أريد تسميتهم بقيم الخلايا من a1:a30

    2- كيف يمكن اختصار الكود التالي ؟ 

    Private Sub CommandButton1_Click()
   Range("c1") = CommandButton1.Caption
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>"
End Sub

Private Sub CommandButton2_Click()
   Range("c1") = CommandButton2.Caption
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>"
End Sub
Private Sub CommandButton3_Click()
   Range("c1") = CommandButton3.Caption
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>"
End Sub
Private Sub CommandButton4_Click()
   Range("c1") = CommandButton4.Caption
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>"
End Sub
Private Sub CommandButton5_Click()
   Range("c1") = CommandButton5.Caption
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>"
End Sub
Private Sub CommandButton6_Click()
   Range("c1") = CommandButton6.Caption
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>"
End Sub
Private Sub CommandButton7_Click()
   Range("c1") = CommandButton7.Caption
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>"
End Sub
Private Sub CommandButton8_Click()
   Range("c1") = CommandButton8.Caption
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>"
End Sub
Private Sub CommandButton9_Click()
   Range("c1") = CommandButton9.Caption
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>"
End Sub
Private Sub CommandButton10_Click()
   Range("c1") = CommandButton10.Caption
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>"
End Sub
Private Sub CommandButton11_Click()
   Range("c1") = CommandButton11.Caption
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>"
End Sub
Private Sub CommandButton12_Click()
   Range("c1") = CommandButton12.Caption
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>"
End Sub
Private Sub CommandButton13_Click()
   Range("c1") = CommandButton1.Caption
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>"
End Sub
Private Sub CommandButton13_Click()
   Range("c1") = CommandButton1.Caption
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1
    Sheets("filter").Range("$A$1:$C$38").AutoFilter Field:=1, Criteria1:="<>"
End Sub

     

    محتاج تحديد الوقت الإضافي

    في منتدى الاكسيل Excel

    قام بنشر

    أخي محمد

    انظر المرفق

    تم عمل الآتي 

    ترحيل الدخول والخروج اى شيت منفصل 

    يمكنك استنباط ما تريد من تلك الفكرة

    يمكنك عمل تقرير لكل موظف منفرد أو تجميع كل شهر على حده 

    حاول أنت واذا أوقفك شئ أخبرنا

    calculation - Mar. 2016 salim.rar

    محتاج تحديد الوقت الإضافي

    في منتدى الاكسيل Excel

    قام بنشر

    &&المعادلة الموجودة في التقرير غير المكتوبة في الرد

    فكرة العمل أن دالة vlookup تتقوم بجلب قيمة واحدة فقط لكل متغير

    فتم التغلب على المكشلة بواسطة المعادلة الموجودة في العمود a في شيت print 

    ثم في التقرير الباسورد 12345 فك الحماية وانظر المعادلة

     

    &&النقطة الأخرى 

    الذي فهمته أنك تريد عمل شيت print بالمعادلات كما هو موجود بدلا من أن تنقل اسم اسم

    أنا حاليا مشغول شوية بس أوعدك إن شاء الله أحاول أو يسبقني أحد الأخوة

     

×
×
  • اضف...

Important Information

  I accept