كود من تصميم الاستاذ سليم اريد زيادة عدد الاعمدة بكود الاستدعاء

omhamzh · نوفمبر 23, 2020

السلام على من اتبع الهدى

الكود من تصميم استدى سليم حاصبيا واشكر فضله

حاولت بكل الطرق بس لم ينجح الكود والموضوع تم اغلاقه

احتاج لشرج ما اقوم بعمله لزيادة الاعمدة للعمود P

بارك الله فى صاحب الكود الاستاذ سليم ونجاه من كل شر

Option Explicit
Dim i%, Max_ro%, K%, m%, All_rows%
Dim J As Worksheet
Dim Spes_sh As Worksheet
Dim D1 As Date, D2 As Date
Dim x As Boolean

'+++++++++++++++++++++++++++++++++++
Sub Fil_data()
Dim t%, cont%, n%
m = 5: t = 5
Set J = Sheets("Justify")

All_rows = J.Cells(Rows.Count, 1).End(3).Row
If All_rows > 4 Then
J.Range("A5:L" & All_rows + 5).Clear
End If
If Not IsDate(J.Range("B2")) Or Not IsDate(J.Range("C2")) Then
 MsgBox "Type Please a reel date in B2 and C2"
 Exit Sub
End If
D1 = Application.Min(J.Range("B2"), J.Range("C2"))
D2 = Application.Max(J.Range("B2"), J.Range("C2"))
J.Range("B2") = D1: J.Range("C2") = D2

For Each Spes_sh In Sheets
       If Spes_sh.Name = "Tarhil" Or Spes_sh.Name = "Justify" Then
        Else
          Max_ro = Spes_sh.Cells(Rows.Count, 2).End(3).Row
              If Max_ro = 1 Then GoTo Next_SHeeet
             For K = 2 To Max_ro
               If Spes_sh.Cells(K, 1) <= D2 _
                And Spes_sh.Cells(K, 1) >= D1 Then
                J.Cells(m, 2).Resize(, 11).Value = _
                Spes_sh.Cells(K, 1).Resize(, 11).Value
                    If Not x Then
                      Else
                     J.Cells(m, 3) = ""
                    End If
                    x = True
                m = m + 1
              End If
             Next K
      End If
Next_SHeeet:
    If Spes_sh.Name = "Tarhil" Or _
      Spes_sh.Name = "Justify" Then
    Else
      J.Cells(m, 2) = "Sum"
      J.Cells(m, 4).Resize(, 9).Formula = _
      "=SUM(D" & t & ":D" & m - 1 & ")"
      m = m + 1
      t = m
   End If
x = False
  
Next Spes_sh
If m > 5 Then

 For cont = 5 To m - 1
        If J.Cells(cont, 2) <> "Sum" Then
        J.Cells(cont, 1) = n + 1
        n = n + 1
    Else
        J.Cells(cont, 1).Resize(, 12). _
        Interior.ColorIndex = 35
    End If
 Next cont
    
      With J.Cells(5, 1).Resize(m - 5, 12)
        .HorizontalAlignment = xlCenter
        .Borders.LineStyle = 1: .Font.Size = 14
        .Font.Bold = True
        .Value = .Value
        .InsertIndent 1
      End With
  
 For cont = 5 To m - 1
    If J.Cells(cont, 2) = "Sum" Then
      With J.Cells(cont, 2).Resize(, 2)
        .Merge
        .HorizontalAlignment = 3
      End With
    End If
 Next cont
  
End If
End Sub

والله ولى التوفيق

بارك الله فيك استاذ سليم

تـــم تعديل الملف

Om_Hamz_Matloub.xlsm

**سليم حاصبيا** · نوفمبر 23, 2020

خلاص بفى احر مناقشة بهذا الموضوع

الكود بعد التعديل

Option Explicit
Dim i%, Max_ro%, K%, m%, All_rows%
Dim J As Worksheet
Dim Spes_sh As Worksheet
Dim D1 As Date, D2 As Date
Dim x As Boolean

'+++++++++++++++++++++++++++++++++++
Sub Fil_data()
Application.ScreenUpdating = False
Dim t%, cont%, n%
m = 5: t = 5
Set J = Sheets("Justify")

All_rows = J.Cells(Rows.Count, 1).End(3).Row
If All_rows > 4 Then
J.Range("A5:O" & All_rows + 5).Clear
End If
If Not IsDate(J.Range("B2")) Or Not IsDate(J.Range("C2")) Then
 MsgBox "Type Please a reel date in B2 and C2"
 GoTo Buy_Buy_Ya_Helween
End If
D1 = Application.Min(J.Range("B2"), J.Range("C2"))
D2 = Application.Max(J.Range("B2"), J.Range("C2"))
J.Range("B2") = D1: J.Range("C2") = D2

For Each Spes_sh In Sheets
       If Spes_sh.Name = "Tarhil" Or Spes_sh.Name = "Justify" Then
        Else
          Max_ro = Spes_sh.Cells(Rows.Count, 2).End(3).Row
              If Max_ro = 1 Then GoTo Next_SHeeet
             For K = 2 To Max_ro
               If Spes_sh.Cells(K, 1) <= D2 _
                And Spes_sh.Cells(K, 1) >= D1 Then
                J.Cells(m, 2).Resize(, 14).Value = _
                Spes_sh.Cells(K, 3).Resize(, 14).Value
                    If Not x Then
                     J.Cells(m, 1) = Spes_sh.Name
                    End If
                    x = True
                m = m + 1
              End If
             Next K
      End If
      x = False
Next_SHeeet:
    If Spes_sh.Name = "Tarhil" Or _
      Spes_sh.Name = "Justify" Then
    Else
      J.Cells(m, 1) = "Sum"
      J.Cells(m, 2).Resize(, 14).Formula = _
      "=SUM(B" & t & ":B" & m - 1 & ")"
      m = m + 1
     t = m
   End If
x = False
  
Next Spes_sh
If m > 5 Then

 For cont = 5 To m - 1
    If J.Cells(cont, 1) = "Sum" Then
      J.Cells(cont, 1).Resize(, 15). _
      Interior.ColorIndex = 35
    End If
 Next cont
    J.Cells(m, 1) = "Sum Of ALL"
   
    J.Cells(m, 2).Resize(, 14).Formula = _
    "=SUM(B5:B" & m - 1 & ")/2"
    J.Cells(m, 1).Resize(, 15).Interior.ColorIndex = 40
      With J.Cells(5, 1).Resize(m - 4, 15)
        .HorizontalAlignment = xlCenter
        .Borders.LineStyle = 1: .Font.Size = 14
        .Font.Bold = True
        .Value = .Value
        .InsertIndent 1
      End With

End If
Buy_Buy_Ya_Helween:
Application.ScreenUpdating = True
End Sub

الملف مرفق

Om_Hamz_Super.xlsm

omhamzh · نوفمبر 23, 2020

الله يرضى عنك وعن والديك بس الكود الثانى لم يتم فيه التعديل

التعديل شمل كود واحد فى البرنامج الاستدعاء حضرتك عامل لى كود ين واحد تم تعديله والاخر لم يتم متتعبش حضرتك اشرح لى وانا هعدل

انا بشكرك زاد الله علمك وكرمك

الكود الاخر هو


Application.ScreenUpdating = False
Set J = Sheets("Justify")

J.Range("A5:L5000").Clear

If Not IsDate(J.Range("B2")) Or Not IsDate(J.Range("C2")) Then
 MsgBox "Type Please a reel date in B2 and C2"
 Exit Sub
End If
D1 = Application.Min(J.Range("B2"), J.Range("C2"))
D2 = Application.Max(J.Range("B2"), J.Range("C2"))
J.Range("B2") = D1: J.Range("C2") = D2

For Each Spes_sh In Sheets
    If Spes_sh.Name = "Tarhil" Or Spes_sh.Name = "Justify" Then
    Else
        Max_ro = Spes_sh.Cells(Rows.Count, 2).End(3).Row
        Spes_sh.Range("A2").Resize(Max_ro - 1, 11) _
        .Interior.ColorIndex = 35
        For col = 3 To 11
            my_sum = 0
            For ro = 2 To Max_ro
                If Spes_sh.Cells(ro, 1) <= D2 And _
                  Spes_sh.Cells(ro, 1) >= D1 Then
                  Spes_sh.Cells(ro, 1).Interior.ColorIndex = 40
                  Spes_sh.Cells(ro, col).Interior.ColorIndex = 40
                  my_sum = my_sum + Val(Spes_sh.Cells(ro, col))
                End If
            Next ro
            
            ro = J.Cells(Rows.Count, "j").End(3).Row
            m = IIf(ro = 3, 5, ro + 1)
            J.Cells(m, col - 1) = my_sum
            J.Cells(m, 1) = Spes_sh.Name
        Next col
    End If

 Next Spes_sh
 If m > 5 Then
  J.Cells(m + 1, 1) = "SUM"
  J.Cells(m + 1, 2).Resize(, 9).Formula = _
    "=SUM(B5:B" & m & ")"
   J.Cells(5, "J").Resize(m - 4).Formula = _
    "=SUM(B5:I5)"
    With J.Cells(5, 1).Resize(m - 3, 10)
        .HorizontalAlignment = xlCenter
        .Borders.LineStyle = 1: .Font.Size = 14
        .Font.Bold = True
        .Value = .Value
        .InsertIndent 1
   End With
 J.Cells(m + 1, 1).Resize(, 10).Interior.ColorIndex = 40
End If
Application.ScreenUpdating = True
End Sub

**سليم حاصبيا** · نوفمبر 23, 2020

الان, omhamzh said:

الله يرضى عنك وعن والديك بس الكود الثانى لم يتم فيه التعديل

التعديل شمل كود واحد فى البرنامج الاستدعاء حضرتك عامل لى كود ين واحد تم تعديله والاخر لم يتم متتعبش حضرتك اشرح لى وانا هعدل

انا بشكرك زاد الله علمك وكرمك

الكود الاخر هو



Application.ScreenUpdating = False
Set J = Sheets("Justify")

J.Range("A5:L5000").Clear

If Not IsDate(J.Range("B2")) Or Not IsDate(J.Range("C2")) Then
 MsgBox "Type Please a reel date in B2 and C2"
 Exit Sub
End If
D1 = Application.Min(J.Range("B2"), J.Range("C2"))
D2 = Application.Max(J.Range("B2"), J.Range("C2"))
J.Range("B2") = D1: J.Range("C2") = D2

For Each Spes_sh In Sheets
    If Spes_sh.Name = "Tarhil" Or Spes_sh.Name = "Justify" Then
    Else
        Max_ro = Spes_sh.Cells(Rows.Count, 2).End(3).Row
        Spes_sh.Range("A2").Resize(Max_ro - 1, 11) _
        .Interior.ColorIndex = 35
        For col = 3 To 11
            my_sum = 0
            For ro = 2 To Max_ro
                If Spes_sh.Cells(ro, 1) <= D2 And _
                  Spes_sh.Cells(ro, 1) >= D1 Then
                  Spes_sh.Cells(ro, 1).Interior.ColorIndex = 40
                  Spes_sh.Cells(ro, col).Interior.ColorIndex = 40
                  my_sum = my_sum + Val(Spes_sh.Cells(ro, col))
                End If
            Next ro
            
            ro = J.Cells(Rows.Count, "j").End(3).Row
            m = IIf(ro = 3, 5, ro + 1)
            J.Cells(m, col - 1) = my_sum
            J.Cells(m, 1) = Spes_sh.Name
        Next col
    End If

 Next Spes_sh
 If m > 5 Then
  J.Cells(m + 1, 1) = "SUM"
  J.Cells(m + 1, 2).Resize(, 9).Formula = _
    "=SUM(B5:B" & m & ")"
   J.Cells(5, "J").Resize(m - 4).Formula = _
    "=SUM(B5:I5)"
    With J.Cells(5, 1).Resize(m - 3, 10)
        .HorizontalAlignment = xlCenter
        .Borders.LineStyle = 1: .Font.Size = 14
        .Font.Bold = True
        .Value = .Value
        .InsertIndent 1
   End With
 J.Cells(m + 1, 1).Resize(, 10).Interior.ColorIndex = 40
End If
Application.ScreenUpdating = True
End Sub

انت طلبت التعديل على هذا الماكرو فقط

**سليم حاصبيا** · نوفمبر 23, 2020

الكود الثّاني

Option Explicit

Dim i%, Max_ro%, m%
Dim J As Worksheet
Dim ro%, col%, my_sum#
Dim Spes_sh As Worksheet
Dim D1 As Date, D2 As Date
'+++++++++++++++++++++++++++++++++++
Sub Fil_data_All()
Application.ScreenUpdating = False
Set J = Sheets("Justify")

J.Range("A5:O5000").Clear

If Not IsDate(J.Range("B2")) Or Not IsDate(J.Range("C2")) Then
 MsgBox "Type Please a reel date in B2 and C2"
 GoTo Live_Me_PLease
End If
D1 = Application.Min(J.Range("B2"), J.Range("C2"))
D2 = Application.Max(J.Range("B2"), J.Range("C2"))
J.Range("B2") = D1: J.Range("C2") = D2

For Each Spes_sh In Sheets
    If Spes_sh.Name = "Tarhil" Or Spes_sh.Name = "Justify" Then
    Else
   
        Max_ro = Spes_sh.Cells(Rows.Count, 2).End(3).Row
        Spes_sh.Range("A2").Resize(Max_ro - 1, 16) _
        .Interior.ColorIndex = 35
        For col = 3 To 16
            my_sum = 0
            For ro = 2 To Max_ro
                If Spes_sh.Cells(ro, 1) <= D2 And _
                  Spes_sh.Cells(ro, 1) >= D1 Then
                  Spes_sh.Cells(ro, 1).Interior.ColorIndex = 40
                  Spes_sh.Cells(ro, col).Interior.ColorIndex = 40
                  my_sum = my_sum + Val(Spes_sh.Cells(ro, col))
                End If
            Next ro
            
            ro = J.Cells(Rows.Count, "O").End(3).Row
            m = IIf(ro <= 3, 5, ro + 1)
            J.Cells(m, col - 1) = my_sum
            J.Cells(m, 1) = Spes_sh.Name
        Next col
    End If

 Next Spes_sh
 If m > 5 Then
  J.Cells(m + 1, 1) = "SUM"
  J.Cells(m + 1, 2).Resize(, 14).Formula = _
    "=SUM(B5:B" & m & ")"
   J.Cells(5, "O").Resize(m - 4).Formula = _
    "=SUM(B5:N5)"
    With J.Cells(5, 1).Resize(m - 3, 15)
        .HorizontalAlignment = xlCenter
        .Borders.LineStyle = 1: .Font.Size = 14
        .Font.Bold = True
        .Value = .Value
        .InsertIndent 1
   End With
 J.Cells(m + 1, 1).Resize(, 15).Interior.ColorIndex = 40
End If
Live_Me_PLease:
Application.ScreenUpdating = True
End Sub

omhamzh · نوفمبر 23, 2020

شكرا ليك يا اطيب انسان

اربنا يحفظك ويزيدك من فضله ويعزك ويرفع شأنك ويديم عليك كل نعمه

اختك فى الله تقدم لك كل الشكر موقف شهم جداااااااااا من حضرتك ربنا يعزك ويحفظك

yara ahmed · نوفمبر 23, 2020

ماشاء الله عليك اخى

تسجيل الدخول

كود من تصميم الاستاذ سليم اريد زيادة عدد الاعمدة بكود الاستدعاء

الردود الموصى بها

omhamzh

سليم حاصبيا

omhamzh

سليم حاصبيا

سليم حاصبيا

omhamzh

yara ahmed

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information