أكاديمية الصقر للتدريب
FBConnect

اعلان هنا
صقور الاكسيل
أعلن هنا
أعلن هنا
صفحتنا على الفيس بوك
أعلن هنا




أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .

Preview

الرئيسية
نتائج البحث


نتائج البحث عن ردود العضو :salim
عدد النتائج (775) نتيجة
17-12-2020 07:42 صباحا
icon كود ترحيل لمطعم | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 ربما تريد هذا الشيء

Dim my_sheet As Worksheet
Dim Sh As Worksheet
Dim Ro_sh%, i%, Final_Ro
Dim Rg As Range
Dim Find_what As Range
Dim Bt

'++++++++++++++++++++++++++++
Sub Debut()
  Set my_sheet = Sheets("ثوابت")
  Set Sh = Sheets("مبيعات")
   Ro = my_sheet.Cells(Rows.Count, 1).End(3).Row
   Ro_sh = Sh.Cells(Rows.Count, 2).End(3).Row + 1
  Set Rg = my_sheet.Range("a3:a" & Ro)
  Set Bt = UserForm1.ActiveControl
End Sub
'++++++++++++++++++++++++++++++++
Private Sub UserForm_Click()
  With Application
  .ScreenUpdating = fasle
  .Calculation = xlCalculationManual
  End With

Debut
 If TypeName(Bt) <> "CommandButton" Then GoTo Bay_Bay
 If Bt.Caption Like "*صنف*" Then
       Me.T_date = ""
      For i = 2 To 5
        Me.Controls("T_" & i) = vbNullString
      Next

 Set Find_what = Rg.Find(Bt.Caption, lookat:=1)
 If Not Find_what Is Nothing Then
      
        Me.T_date = Format(Date, "[$-ar-Lb] ddd d mmm yy")
      For i = 2 To 5
          Select Case i
            Case 2: st = "  بيع: "
            Case 3: st = "  تكلفة: "
            Case 4: st = "  الوزن: "
            Case 5: st = "  التصنيف: "
          End Select
             Me.Controls("T_" & i) = _
             st & my_sheet.Cells(Find_what.Row, i)
      Next
         
         With Sh.Cells(Ro_sh, 2)
         .Value = Format(Date, "[$-ar-lb] ddd d mmm yy")
         .Offset(, 2) = Bt.Caption
         .Offset(, 4) = my_sheet.Cells(Find_what.Row, 2)
         .Offset(, 5) = my_sheet.Cells(Find_what.Row, 3)
         .Offset(, 8) = my_sheet.Cells(Find_what.Row, 4)
         .Offset(, 9) = my_sheet.Cells(Find_what.Row, 5)
        End With
   Else
      GoTo Bay_Bay
  End If
 End If

 Final_Ro = Sh.Cells(Rows.Count, 2).End(3).Row
 If Final_Ro > 5 Then
   Sh.Range("H6:H" & Final_Ro).Formula = _
    "=IF(OR(E6="""",F6=""""),"""",PRODUCT(E6,F6))"
   Sh.Range("I6:I" & Final_Ro).Formula = _
    "=IF(OR(E6="""",G6=""""),"""",PRODUCT(E6,G6))"
    Sh.Range("A6:A" & Final_Ro).Formula = _
 "=SUMPRODUCT(--(B6&D6=$B$6:$B6&$D$6:$D6)) &"" (""&D6&"" لهذا اليوم  )"""
  With Sh.Range("A6:K" & Final_Ro)
     .HorizontalAlignment = 1
     .InsertIndent 1
     .Borders.LineStyle = 1
     .Font.Size = 14
     .Font.Bold = True
  End With
 End If
Bay_Bay:
 With Application
  .ScreenUpdating = True
  .Calculation = xlCalculationAutomatic
 End With
End Sub


الملف مرفق
16-12-2020 09:55 مساء
icon كود ترحيل لمطعم | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 تم وضع الكود بالكامل
  تضغط على الصنف الذي تريده ثم كليك على اليوزر فتذهب الدتا الى    TextBoxes   و الى الشيت "مبيعات بدون تكرار" بالاضافى الى المعادلات اللازمة لـــ اجمالى البيع و اجمالى التكلفة
هذه المعدلات لا تعمل الا اذا كانت الخلايا في E و F و  G غير فارغة
الكود:

Dim my_sheet As Worksheet
Dim Sh As Worksheet
Dim Ro_sh%, i%, Final_Ro
Dim Rg As Range
Dim Find_what As Range
Dim Bt

'++++++++++++++++++++++++++++
Sub Debut()
  Set my_sheet = Sheets("ثوابت")
  Set Sh = Sheets("مبيعات")
   Ro = my_sheet.Cells(Rows.Count, 1).End(3).Row
   Ro_sh = Sh.Cells(Rows.Count, 2).End(3).Row + 1
  Set Rg = my_sheet.Range("a3:a" & Ro)
  Set Bt = UserForm1.ActiveControl
End Sub
'++++++++++++++++++++++++++++++++
Private Sub UserForm_Click()
  With Application
  .ScreenUpdating = fasle
  .Calculation = xlCalculationManual
  End With

Debut
 If TypeName(Bt) <> "CommandButton" Then GoTo Bay_Bay
 If Bt.Caption Like "*صنف*" Then
       Me.T_date = ""
      For i = 2 To 5
        Me.Controls("T_" & i) = vbNullString
      Next

 Set Find_what = Rg.Find(Bt.Caption, lookat:=1)
 If Not Find_what Is Nothing Then
      
        Me.T_date = Format(Date, "[$-ar-Lb] ddd d mmm yy")
      For i = 2 To 5
          Select Case i
            Case 2: st = "  بيع: "
            Case 3: st = "  تكلفة: "
            Case 4: st = "  الوزن: "
            Case 5: st = "  التصنيف: "
          End Select
             Me.Controls("T_" & i) = _
             st & my_sheet.Cells(Find_what.Row, i)
      Next
         
         With Sh.Cells(Ro_sh, 2)
         .Value = Format(Date, "[$-ar-lb] ddd d mmm yy")
         .Offset(, 2) = Bt.Caption
         .Offset(, 4) = my_sheet.Cells(Find_what.Row, 2)
         .Offset(, 5) = my_sheet.Cells(Find_what.Row, 3)
         .Offset(, 8) = my_sheet.Cells(Find_what.Row, 4)
         .Offset(, 9) = my_sheet.Cells(Find_what.Row, 5)
        End With
   Else
      GoTo Bay_Bay
  End If
 End If
 Sh.Range("B5:K" & Ro_sh + 1).RemoveDuplicates _
  Columns:=Array(1, 2, 3, 4, 5, 6, _
    9, 10), Header:=xlYes
 Final_Ro = Sh.Cells(Rows.Count, 2).End(3).Row
 If Final_Ro > 5 Then
   Sh.Range("H6:H" & Final_Ro).Formula = _
    "=IF(OR(E6="""",F6=""""),"""",PRODUCT(E6,F6))"
   Sh.Range("I6:I" & Final_Ro).Formula = _
    "=IF(OR(E6="""",G6=""""),"""",PRODUCT(E6,G6))"
  With Sh.Range("A6:K" & Final_Ro)
     .HorizontalAlignment = 1
     .InsertIndent 1
     .Borders.LineStyle = 1
     .Font.Size = 14
     .Font.Bold = True
  End With
 End If
Bay_Bay:
 With Application
  .ScreenUpdating = True
  .Calculation = xlCalculationAutomatic
 End With
End Sub

الملف مرفق
 
16-12-2020 01:30 مساء
icon كود ترحيل لمطعم | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 بعد الضغط على الزر لا يتم ترحيل هذه البيانات الى شيت المبيعات
أنت لم تطلب ذلك في سؤالك
بل قلت ان تنتقل المعلومات الى التكست بوكسات
15-12-2020 01:18 مساء
icon محتاج أحذف رقم 3 من دالة lift | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 هذه المعادلة تفي بالغرض ان شاء الله

=IF(B2="","","std#"&SUBSTITUTE(LEFT(B2,7),"3","",1))
14-12-2020 05:08 مساء
icon كود ترحيل لمطعم | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 هذا الكود يمكنه تشغيل كل الأزار التي تحتوي على كلمة "صنف"
1- اضغط الزر المناسب(يحتوي على كلمة "صنف")
2- اضغط في اي مكان على اليوزر (المنطقة الحمراء)
3- تنتقل المعلومات من الشيت (ثوابت) الى التكست بوكس المناسب

Dim my_sheet As Worksheet
Dim Ro%, i%
Dim Rg As Range
Dim Find_what As Range
Dim Bt
'++++++++++++++++++++++++++++
Sub Debut()
  Set my_sheet = Sheets("ثوابت")
  Ro = my_sheet.Cells(Rows.Count, 1).End(3).Row
  Set Rg = my_sheet.Range("a3:a" & Ro)
  Set Bt = UserForm1.ActiveControl
End Sub
'++++++++++++++++++++++++++++++++
Private Sub UserForm_Click()
Debut
 If Bt.Caption Like "*صنف*" Then
 Me.T_date = ""
    For i = 2 To 5
      Me.Controls("T_" & i) = vbNullString
    Next
'++++++++++++++++++++++++++++++
 Set Find_what = Rg.Find(Bt.Caption, lookat:=1)
 If Not Find_what Is Nothing Then
  Me.T_date = Format(Date, "[$-ar-Lb] ddd d mmm yy")
 For i = 2 To 5
 Select Case i
   Case 2: st = "  بيع: "
   Case 3: st = "  تكلفة: "
   Case 4: st = "  الوزن: "
   Case 5: st = "  التصنيف: "
 End Select
    Me.Controls("T_" & i) = _
    st & my_sheet.Cells(Find_what.Row, i)
 Next
 End If
 End If
End Sub

الملف مرفق
14-12-2020 01:56 مساء
icon كود ترحيل لمطعم | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 هذا الكود بالنسبة للصنف1

Dim my_sheet As Worksheet
Dim Ro%, i%
Dim Rg As Range
Dim Find_what As Range
Sub Debut()
  Set my_sheet = Sheets("ثوابت")
  Ro = my_sheet.Cells(Rows.Count, 1).End(3).Row
  Set Rg = my_sheet.Range("a3:a" & Ro)

End Sub
Private Sub CommandButton1_Click() 'Sinf1
 Debut
Dim st$
 Me.T_date = ""
 
  For i = 2 To 5
    Me.Controls("T_" & i) = vbNullString
   Next
 Set Find_what = Rg.Find(Me.CommandButton1.Caption, lookat:=1)
 If Not Find_what Is Nothing Then
  Me.T_date = Format(Date, "[$-ar-Lb] ddd d mmm yy")
 For i = 2 To 5
 Select Case i
   Case 2: st = "  بيع: "
   Case 3: st = "  تكلفة: "
   Case 4: st = "  الوزن: "
   Case 5: st = "  التصنيف: "
 End Select
    Me.Controls("T_" & i) = _
    st & my_sheet.Cells(Find_what.Row, i)
 Next
 End If
End Sub

 
10-12-2020 06:48 صباحا
icon كود طباعة مطاطي مع المحافظة على تنسيق الورقة | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 جرب هذا الكود

Sub Hide_rows()
Dim my_max%
show_rows
my_max = Application.Max(Range("B1:B66")) + 8
If my_max < 66 Then
Range(Cells(my_max + 1, 1), Cells(66, 1)).EntireRow.Hidden = True
End If
End Sub
'+++++++++++++++++++++
Sub show_rows()
Range("B9:B66").EntireRow.Hidden = False
End Sub

07-12-2020 09:37 مساء
icon كيفية استخدام دالة xlookup في ال vba | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 جرب هذا الماكرو
عندي    Excel 2016 و بالتالي لا توجد دالة  Xlookup  للتأكد من عمل الماكرو

Sub dd()
Dim r As Long
    Dim lr As Long
    Dim m As Long
    lr = Cells(Rows.Count, "H").End(xlUp).Row
    For r = 5 To lr Step 12
        Cells(r, 8).Resize(9).Formula = _
       "=XLOOKUP(DC" & r & ",$DF$5:$DF$22,$DG$5:$DG$22)"
     Next r
End Sub
02-12-2020 01:59 مساء
icon سؤال فى الليست بوكس | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 الكود المطلوب

Private Sub Big_To_Smaal_Click()
  Rem Created By Salim On 2/12/2020
  Rem Sort List For ListBox
Dim Ro%, i%, S#
Dim Sh As Worksheet
Dim Lst As Object
Set Sh = Sheets("ورقة1")
Me.ListBox1.Clear
Dim arr
Set Lst = CreateObject("System.Collections.SortedList")
Ro = Sh.Cells(Rows.Count, 4).End(3).Row
 For i = 2 To Ro
 Lst.Add Sh.Cells(i, 4).Value - (1 / (Cells(i, 4).Row * 1000)), i - 1
 Next
 ReDim arr(Lst.Count - 1, 1)
 For i = 0 To Lst.Count - 1
  arr(i, 0) = Int(Lst.GetKey(Lst.Count - 1 - i)) + 1
  arr(i, 1) = Lst.GetByIndex(Lst.Count - 1 - i)
 Next
With Me.ListBox1
For i = LBound(arr, 1) To UBound(arr, 1)
  .AddItem
  .List(.ListCount - 1, 0) = i + 1
  .List(.ListCount - 1, 1) = Sh.Cells(arr(i, 1) + 1, 3)
  .List(.ListCount - 1, 2) = arr(i, 0)
   S = S + Val(arr(i, 0))
  Next
  .AddItem
  .List(.ListCount - 1, 0) = "============="
  .List(.ListCount - 1, 1) = "============="
  .List(.ListCount - 1, 2) = "============="
  
  .AddItem
  .List(.ListCount - 1, 0) = ""
  .List(.ListCount - 1, 1) = "Sum Off ALL"
  .List(.ListCount - 1, 2) = Format(S, "###,###,###.00")
 End With
End Sub

الملف مرفق
29-11-2020 10:34 صباحا
icon اظهار بداية الاسم الاول في الليست بوكس والتكست بوكس  دون تغيير في حجمها | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 قلت لك كتبت لك الكود للــ  TextBox1_Change فقط بالسبة للباقي لم اتعامل معهم





29-11-2020 08:47 صباحا
icon اظهار بداية الاسم الاول في الليست بوكس والتكست بوكس  دون تغيير في حجمها | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 كتبت لك الكود للــ  TextBox1_Change  اعمل الباقي نفس الشيء
 
28-11-2020 09:48 مساء
icon بحث بالاسم وتعبئة باقي الخلايا | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 جرب هذا الملف

الصفحة 5 من 65 < 1 4 5 6 65 > الأخيرة »





الساعة الآن 12:00 صباحا

أعلن هنا
أعلن هنا
أعلن هنا