مشكلة في حساب عدد الاسابيع مع التواريخ بالحلقات التكرارية

[AliAli47]

السلام عليكم 

قمت بإنشاء قاعدة بيانات بسيطة لحساب عدد الاسابيع في السنة مع وضع تاريخ بداية ونهاية كل أسبوع عن طريق الحلقات التكرارية for 

لكن الاشكالية ان تاريخ نهاية الاسبوع الاول وبداية الاسبوع الثاني تحسب مرتين كما اني اريد ازالة يوم الجمعة 

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

ملاحظة : حساب الاسابيع يبدأ بأول أسبوع يبدأ بيوم السبت في السنة 

ex.accdb

تم تعديل نوفمبر 3, 2021 بواسطه AliAli47

[jjafferr]

وعليكم السلام 🙂

 

تفضل:

    'all weeks of the year
    'Week Number, Saturday, Thursday
    
    Dim D As Date, Date_1 As Date, Date_2 As Date
    Dim i As Integer, W As Integer
    
    For i = 0 To 366
    
        D = DateAdd("d", i, "1-1-" & Year(Date))
        If D >= "31-12-" & Year(Date) Then Exit For
        
        If Weekday(D) = 7 Then
            
            Date_1 = D                          'Saturday
            Date_2 = DateAdd("d", 5, Date_1)    'Thursday
            W = W + 1
            
            Debug.Print W & vbTab & Date_1 & vbTab & Date_2
        
        End If
        
    Next i
    

.

 

جعفر

[AliAli47]

في ٣‏/١١‏/٢٠٢١ at 15:57, jjafferr said:

وعليكم السلام 🙂

 

تفضل:

    'all weeks of the year
    'Week Number, Saturday, Thursday
    
    Dim D As Date, Date_1 As Date, Date_2 As Date
    Dim i As Integer, W As Integer
    
    For i = 0 To 366
    
        D = DateAdd("d", i, "1-1-" & Year(Date))
        If D >= "31-12-" & Year(Date) Then Exit For
        
        If Weekday(D) = 7 Then
            
            Date_1 = D                          'Saturday
            Date_2 = DateAdd("d", 5, Date_1)    'Thursday
            W = W + 1
            
            Debug.Print W & vbTab & Date_1 & vbTab & Date_2
        
        End If
        
    Next i
    

.

 

جعفر

الكود لم يشتغل 

[ابو جودي]

9 دقائق مضت, AliAli47 said:

الكود لم يشتغل 

الكود شغال تمام 

فقط جرب
 

    'all weeks of the year
    'Week Number, Saturday, Thursday
    
    Dim D As Date, Date_1 As Date, Date_2 As Date
    Dim i As Integer, W As Integer
    
    For i = 0 To 366
    
        D = DateAdd("d", i, "1-1-" & Year(Date))
        If D >= "31-12-" & Year(Date) Then Exit For
        
        If Weekday(D) = 7 Then
            
            Date_1 = D                          'Saturday
            Date_2 = DateAdd("d", 5, Date_1)    'Thursday
            W = W + 1
            
            Debug.Print W & vbTab & Date_1 & vbTab & Date_2
            n_semaine = W
            Dates1 = Date_1
            dates2 = Date_2
            DoCmd.RunCommand acCmdRecordsGoToNew
        End If
    Next i

 

[AliAli47]

الان, ابا جودى said:

الكود شغال تمام 

فقط جرب
 

    'all weeks of the year
    'Week Number, Saturday, Thursday
    
    Dim D As Date, Date_1 As Date, Date_2 As Date
    Dim i As Integer, W As Integer
    
    For i = 0 To 366
    
        D = DateAdd("d", i, "1-1-" & Year(Date))
        If D >= "31-12-" & Year(Date) Then Exit For
        
        If Weekday(D) = 7 Then
            
            Date_1 = D                          'Saturday
            Date_2 = DateAdd("d", 5, Date_1)    'Thursday
            W = W + 1
            
            Debug.Print W & vbTab & Date_1 & vbTab & Date_2
            n_semaine = W
            Dates1 = Date_1
            dates2 = Date_2
            DoCmd.RunCommand acCmdRecordsGoToNew
        End If
    Next i

 

نعم جربته لما اضغط على الزر لا يعمل 

ممكن ترفق الكود في المثال لو تكرمت 

[ابو جودي]

اتفضل يا سيدى 

 

ex.accdb

[jjafferr]

وهذه مشاركتي مع اخوي ابوجودي 🙂

 

استعمل النموذج frm_Generate_Weeks

.

وهكذا اصبح الكود:

Private Sub cmd_Calc_Click()

    'all weeks of the year
    'Week Number, Saturday, Thursday
    
    'do we have a Year
    If Len(Me.iYear & "") = 0 Then
        MsgBox "رجاء ادخال السنه التي تريد العمل عليها"
        Me.iYear.SetFocus
        Exit Sub
    End If
    
    
    'Do we have iYear data in the table?
    If DCount("*", "semaine", "Year([dates1])=" & Me.iYear) Then
        MsgBox "الجدول به بيانات سنة " & Me.iYear & vbCrLf & vbCrLf & _
               "لا يمكن الاستمرار"
        Exit Sub
    End If
    
    
    Dim D As Date, Date_1 As Date, Date_2 As Date
    Dim i As Integer, W As Integer
    Dim rst As DAO.Recordset
    
    Set rst = CurrentDb.OpenRecordset("Select * From semaine")
    
    For i = 0 To 366
    
        D = DateAdd("d", i, "1-1-" & Me.iYear)
        If D >= "31-12-" & Me.iYear Then Exit For
        
        If Weekday(D) = 7 Then
            
            Date_1 = D                          'Saturday
            Date_2 = DateAdd("d", 5, Date_1)    'Thursday
            W = W + 1
            
            rst.AddNew
                rst!n_semaine = W
                rst!dates1 = Date_1
                rst!dates2 = Date_2
            rst.Update
            
            'Debug.Print W & vbTab & Date_1 & vbTab & Date_2
        
        End If
        
    Next i
    
    MsgBox "Done"
End Sub

 

جعفر

Week, Saturday, Thursday of the year.zip

[ابو جودي]

25 دقائق مضت, jjafferr said:

وهذه مشاركتي مع اخوي ابوجودي 🙂

 

استعمل النموذج frm_Generate_Weeks

جعفر

Week, Saturday, Thursday of the year.zip 340.67 kB · 0 downloads

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

تم تعديل نوفمبر 6, 2021 بواسطه ابا جودى

[jjafferr]

8 دقائق مضت, ابا جودى said:

ولكن والله فكرت بها كذلك

طبعا اعرف هذا الشيء ، فهذه هي الحاسة السابعة للمبرمج 🙂

جعفر

[AliAli47]

بارك الله في الأستاذ @jjafferr والأستاذ @ابا جودى