05-06-16, 11:03 AM
وعليكم السلام ورحمة الله تعالى وبركاته
سأنسخ لك كود سورس المعمل في برنامج أكسيل
Private Sub CommandButton3_Click()
Dim qte As Double
Dim j, num As Integer
Dim p
p = "D:\Raports\MSJA\"
MakeSureDirectoryPathExists (p)
qte = 0
som = 0
On Error GoTo errd
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("D:\Raports\MSJA\RptArticlesmsj.txt", True)
a.writeline "=====Rapport DU: " & TextBox3.Value & " AU: " & TextBox4 & "==="
a.writeline "¦_______________________________________________________________________________¦"
For Each Sh In Worksheets
If Sh.Name <> "ãáÎÕ" Then
For j = 1 To 200
If IsDate(Sh.Cells(j, 1).Value) = True Then
If Sh.Cells(j, 1).Value >= CDate(TextBox3.Value) Then
If Sh.Cells(j, 1).Value <= CDate(TextBox4.Value) Then
If IsArticle(Sh.Cells(j, 2).Value) Then
num = num + 1
qte = qte + Sh.Cells(j, 3).Value
som = som + Sh.Cells(j, 3).Value * Sh.Cells(j, 4).Value
a.writeline num & " -->" & Trim(Sh.Cells(j, 1).Value) & "|" & Trim(Sh.Cells(j, 2).Value) & "|" & Trim(Sh.Cells(j, 3).Value) & "|" & Trim(Sh.Cells(j, 4).Value) & "|" & Trim(Sh.Name)
a.writeline "¦--------------------------------------------------------------------------------------------------------------------------------¦"
End If
End If
End If
End If
Next j
End If
Next Sh
a.writeline "*********************************************************************************************"
a.writeline " Rapport de tous clients :"
a.writeline " Période du: " & TextBox3 & " au: " & TextBox4
a.writeline "*********************La Quantité totale est: " & Format(qte, "#,###") & "**************"
a.writeline "*********************La somme totale est : " & Format(som, "#,###") & "*************"
a.writeline "**********************************************************************************************"
a.Close
Set fs = Nothing
Shell ("C:\WINDOWS\system32\notepad.exe D:\Raports\MSJA\RptArticlesmsj.txt"), vbMaximizedFocus
Exit Sub
errd:
err.Clear
MsgBox "ÇáÈíÇäÇÊ ÇáÊí ÃÏÎáÊåÇ ÛíÑ ÕÍíÍÉ¡ÍÇæá ãÑÉ ÃÎÑì", vbQuestion + vbMsgBoxRtlReading, "ÎØÃ áÛæí"
TextBox3.SetFocus
End Sub
سأنسخ لك كود سورس المعمل في برنامج أكسيل
Private Sub CommandButton3_Click()
Dim qte As Double
Dim j, num As Integer
Dim p
p = "D:\Raports\MSJA\"
MakeSureDirectoryPathExists (p)
qte = 0
som = 0
On Error GoTo errd
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("D:\Raports\MSJA\RptArticlesmsj.txt", True)
a.writeline "=====Rapport DU: " & TextBox3.Value & " AU: " & TextBox4 & "==="
a.writeline "¦_______________________________________________________________________________¦"
For Each Sh In Worksheets
If Sh.Name <> "ãáÎÕ" Then
For j = 1 To 200
If IsDate(Sh.Cells(j, 1).Value) = True Then
If Sh.Cells(j, 1).Value >= CDate(TextBox3.Value) Then
If Sh.Cells(j, 1).Value <= CDate(TextBox4.Value) Then
If IsArticle(Sh.Cells(j, 2).Value) Then
num = num + 1
qte = qte + Sh.Cells(j, 3).Value
som = som + Sh.Cells(j, 3).Value * Sh.Cells(j, 4).Value
a.writeline num & " -->" & Trim(Sh.Cells(j, 1).Value) & "|" & Trim(Sh.Cells(j, 2).Value) & "|" & Trim(Sh.Cells(j, 3).Value) & "|" & Trim(Sh.Cells(j, 4).Value) & "|" & Trim(Sh.Name)
a.writeline "¦--------------------------------------------------------------------------------------------------------------------------------¦"
End If
End If
End If
End If
Next j
End If
Next Sh
a.writeline "*********************************************************************************************"
a.writeline " Rapport de tous clients :"
a.writeline " Période du: " & TextBox3 & " au: " & TextBox4
a.writeline "*********************La Quantité totale est: " & Format(qte, "#,###") & "**************"
a.writeline "*********************La somme totale est : " & Format(som, "#,###") & "*************"
a.writeline "**********************************************************************************************"
a.Close
Set fs = Nothing
Shell ("C:\WINDOWS\system32\notepad.exe D:\Raports\MSJA\RptArticlesmsj.txt"), vbMaximizedFocus
Exit Sub
errd:
err.Clear
MsgBox "ÇáÈíÇäÇÊ ÇáÊí ÃÏÎáÊåÇ ÛíÑ ÕÍíÍÉ¡ÍÇæá ãÑÉ ÃÎÑì", vbQuestion + vbMsgBoxRtlReading, "ÎØÃ áÛæí"
TextBox3.SetFocus
End Sub
