اذهب الي المحتوي
أوفيسنا

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

قام بنشر (معدل)

السلام عليكم 

كل عام وانت بخير استاتذتي لكرام 

عندي تقرير انزله من الايميل 

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

بالمثال يوجد تقرير للعمل عليه 

شاكرين لكم اساذتي الكرام

 

ادارح الاصناف بضغطت زر.rar

تم تعديل بواسطه ابو زاهر
قام بنشر
3 دقائق مضت, saleh204 said:

إذا لم تكون هذه الطريقة التي تريد فآسف،،،

واستأذنك أن أشارك أخوتي نفس الطريقة التي تم عرضها بالفيديو .

بالمرفق

 إضافة اصناف.rar

ليس هذا استاذي 

قام بنشر

السلام عليكم

استعمل هذا الكود:

On Error Resume Next
Dim req As String

DoCmd.DeleteObject acTable, "zaher11"

Dim PathImg As String
Dim fpath As Variant
With Application.FileDialog(3)
   .Title = "اختر التقرير"
   .Filters.Clear
   .Filters.Add "txt", "*.txt"
   .AllowMultiSelect = False
   .InitialFileName = "d:\"
   If .Show = -1 Then
     PathImg = .SelectedItems(1)
   End If
End With
'-----------------------------------------------------------
DoCmd.TransferText acImportDelim, (";"), "zaher11", PathImg
req = "Delete From zaher11 where isnull(f1);"
DoCmd.SetWarnings False
DoCmd.RunSQL req
 DoCmd.SetWarnings True

'----------------------------------------------------------------
Dim rst  As DAO.Recordset
            Dim i As Integer, RC As Integer
                Set rst = CurrentDb.OpenRecordset("SELECT * FROM [zaher11]")
                        rst.MoveLast: rst.MoveFirst
                    RC = rst.RecordCount
    For i = 1 To RC
       If DCount("*", "[alsnaf]", "[id_sanf]='" & Left(rst!f1, 11) & "'") > 0 Then
                

       'هنا تكتب كود إضافة السلعة للفاتورة
       
       End If
       rst.MoveNext
    Next i

 

ادارح الاصناف بضغطت زر.rar

  • Thanks 1
قام بنشر

تفضل هذا هو شكل الكود الآن:

On Error Resume Next
Dim req As String

DoCmd.DeleteObject acTable, "zaher11"

Dim PathImg As String
Dim fpath As Variant
With Application.FileDialog(3)
   .Title = "ÇÎÊÑ ÇáÊÞÑíÑ"
   .Filters.Clear
   .Filters.Add "txt", "*.txt"
   .AllowMultiSelect = False
   .InitialFileName = "d:\"
   If .Show = -1 Then
     PathImg = .SelectedItems(1)
   End If
End With
'-----------------------------------------------------------
DoCmd.TransferText acImportDelim, (";"), "zaher11", PathImg
req = "Delete From zaher11 where isnull(f1);"
DoCmd.SetWarnings False
DoCmd.RunSQL req
 DoCmd.SetWarnings True

'----------------------------------------------------------------
Dim rst  As DAO.Recordset
            Dim i As Integer, RC As Integer
                Set rst = CurrentDb.OpenRecordset("SELECT * FROM [zaher11]")
                        rst.MoveLast: rst.MoveFirst
                    RC = rst.RecordCount
    For i = 1 To RC
       If DCount("*", "[alsnaf]", "[id_sanf]='" & Left(rst!f1, 11) & "'") > 0 Then
     Me.frmSub_sra.SetFocus
    DoCmd.GoToRecord , , acNewRec
       [frmSub_sra].Form![ID_Sanf] = Left(rst!f1, 11)
     [frmSub_sra].Form![Sanf] = DLookup("Sanf", "[alsnaf]", "[id_sanf]='" & Left(rst!f1, 11) & "'")
     [frmSub_sra].Form![Alkmiah] = Right(rst!f1, InStr(1, rst!f1, " "))
       End If
       rst.MoveNext
    Next i

 

ادارح الاصناف بضغطت زر.rar

  • Thanks 1
قام بنشر

بارك الله فيك استاذي الغالي ممتاز جدا 

هذا ما كنت اريده

الف شكر إليك يالغالي

  • Like 1
قام بنشر
8 ساعات مضت, صالح حمادي said:

الحمد لله أخي

موفق إن شاء الله

استاذي صالح حمادي الفاضل اتعبتك معي السموحه

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

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

لم افهم المعلم بالخط الاحمر والازرق

تحياتي لك ياغالي

 

 [frmSub_sra].Form![ID_Sanf] = Left(rst!f1, 11)
[frmSub_sra].Form![Alkmiah] = Right(rst!f1, InStr(1, rst!f1, " "))
قام بنشر

الدالة Left تقوم بأخذ جزء من سلسلة حرفية من اليسار

الدالة Right تقوم بأخذ جزء من سلسلة حرفية من اليمين

و هذا الرابط تجد به شرح مفصل للدالتين مع امثلة توضيحية:

rst!f1

يمثل حقل الجدول الذي نستورد له البيانات من الملف النصي

Left(rst!f1, 11)

معناه أخذ 11 حرفا الأولى من قيمة الحقل f1

InStr(1, rst!f1, " ")

هذا السطر يقوم بإستخراج مكان الفراغ بين رمز السلعة و الكمية من أجل تسجيل الكمية في حقل الكمية

Right(rst!f1, InStr(1, rst!f1, " "))

هذا السطر يقوم بإستخراج الكمية المباعة.

- من أجل سعر البيع استعمل السطر التالي:

     [frmSub_sra].Form![Asafi] = DLookup("Price_Sales", "[alsnaf]", "[id_sanf]='" & Left(rst!f1, 11) & "'")

- من اجل سطر المجموع أضف السطر التالي:

     [frmSub_sra].Form![mjmo] = [frmSub_sra].Form![Asafi] * [frmSub_sra].Form![Alkmiah]

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

On Error Resume Next
Dim req As String

DoCmd.DeleteObject acTable, "zaher11"

Dim PathImg As String
Dim fpath As Variant
With Application.FileDialog(3)
   .Title = "ÇÎÊÑ ÇáÊÞÑíÑ"
   .Filters.Clear
   .Filters.Add "txt", "*.txt"
   .AllowMultiSelect = False
   .InitialFileName = "d:\"
   If .Show = -1 Then
     PathImg = .SelectedItems(1)
   End If
End With
'-----------------------------------------------------------
DoCmd.TransferText acImportDelim, (";"), "zaher11", PathImg
req = "Delete From zaher11 where isnull(f1);"
DoCmd.SetWarnings False
DoCmd.RunSQL req
 DoCmd.SetWarnings True

'----------------------------------------------------------------
Dim rst  As DAO.Recordset
            Dim i As Integer, RC As Integer
                Set rst = CurrentDb.OpenRecordset("SELECT * FROM [zaher11]")
                        rst.MoveLast: rst.MoveFirst
                    RC = rst.RecordCount
    For i = 1 To RC
       If DCount("*", "[alsnaf]", "[id_sanf]='" & Left(rst!f1, 11) & "'") > 0 Then
     Me.frmSub_sra.SetFocus
    DoCmd.GoToRecord , , acNewRec
       [frmSub_sra].Form![ID_Sanf] = Left(rst!f1, 11)
     [frmSub_sra].Form![Sanf] = DLookup("Sanf", "[alsnaf]", "[id_sanf]='" & Left(rst!f1, 11) & "'")
     [frmSub_sra].Form![Alkmiah] = Right(rst!f1, InStr(1, rst!f1, " "))
     [frmSub_sra].Form![Asafi] = DLookup("Price_Sales", "[alsnaf]", "[id_sanf]='" & Left(rst!f1, 11) & "'")
     [frmSub_sra].Form![mjmo] = [frmSub_sra].Form![Asafi] * [frmSub_sra].Form![Alkmiah]
       
       End If
       rst.MoveNext
    Next i

 

  • Like 1
قام بنشر

استاذي معذره لم اوضح لك بشكل ادق انا ما بدي اخذا السعر من جدول الاصناف لانه الاسعار تتغير فانا بدي كما اخذت الكميه من التقرير المحفوظ بالدي تاخذ السعر 

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

وكان بدي اعرف شرح هذا

لانه عندما نسخه وغيرت اسم بدل الكميه للسعر ما اشتفل فقلت ربما RST!F1 لها مقصود

الف تحيه لك 

شكر كثير

 

 Right(rst!f1, InStr(1, rst!f1, " "))
قام بنشر
منذ ساعه, ابو ياسين المشولي said:

 

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

كيف ناخذ السعر من جدول زاهر  بدل الاصناف  

شكرا لمشاركتك 

قام بنشر
2 دقائق مضت, ابو زاهر said:

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

كيف ناخذ السعر من جدول زاهر  بدل الاصناف  

شكرا لمشاركتك 

العفو اخي ابو زاهر

بالتوفيق

  • Like 1
قام بنشر
14 ساعات مضت, صالح حمادي said:

أعطيني مثال على تقرير به السعر و سوف أعطيك النتيجة

 سامحني استاذي صالح صراحه اتعبتك معي يالغالي ربنا يعطيك العافيه 

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

بعد عملي للتقرير الجديد وحفظ الصيغه الثانيه  لم يدرج معي شي هل المشكله بالتنسيقات

جزاك الله خير استاذنا الغالي

 

الاستاذصالح حمادي.rar

قام بنشر

السلام عليكم:

آسف على الإطالة لأنني مشوش قليلا و ربما سوف أغادر عالم الأكسس إلى عالم VB.NET

هذا شكل الكود الجديد:

On Error Resume Next
Dim req As String
Dim x1 As String, x2 As String, x3 As String, x4 As String
Dim xkamiah As Double
Dim xprix As Currency
Dim xsafi As Currency
Dim xkhasm As String
Dim xtotal As Currency

DoCmd.DeleteObject acTable, "zaher11"

Dim PathImg As String
Dim fpath As Variant
With Application.FileDialog(3)
   .Title = "CIE? C?E????"
   .Filters.Clear
   .Filters.Add "txt", "*.txt"
   .AllowMultiSelect = False
   .InitialFileName = "d:\"
   If .Show = -1 Then
     PathImg = .SelectedItems(1)
   End If
End With
'-----------------------------------------------------------
DoCmd.TransferText acImportDelim, (";"), "zaher11", PathImg
req = "Delete From zaher11 where isnull(f1);"
DoCmd.SetWarnings False
DoCmd.RunSQL req
 DoCmd.SetWarnings True

'----------------------------------------------------------------
Dim rst  As DAO.Recordset
            Dim i As Integer, RC As Integer
                Set rst = CurrentDb.OpenRecordset("SELECT * FROM [zaher11]")
                        rst.MoveLast: rst.MoveFirst
                    RC = rst.RecordCount
    For i = 1 To RC
       If DCount("*", "[alsnaf]", "[id_sanf]='" & Right(rst!f1, 11) & "'") > 0 Then
          Me.frmSub_sra.SetFocus
          DoCmd.GoToRecord , , acNewRec
          x1 = Trim(Mid(rst!f1, 1, Len(rst!f1) - 11))
          xkamiah = Right(x1, InStr(1, rst!f1, " "))
          x2 = Trim(Mid(x1, 1, Len(x1) - Len(xkamiah)))
          xprix = Right(x2, InStr(1, x2, " "))
          x3 = Trim(Mid(x2, 1, Len(x2) - Len(xprix)))
          xkhasm = Right(x3, 6) ')
          MsgBox x3 & "(" & xkhasm & ")"
          
          x4 = Trim(Mid(x3, 1, Len(x3) - Len(xkhasm)))
          xtotal = Right(x4, InStr(1, x4, " ")) ' )
          x5 = Trim(Mid(x4, 1, Len(x4) - Len(xtotal)))
          xsafi = Left(rst!f1, InStr(1, rst!f1, " "))
         [frmSub_sra].Form![ID_Sanf] = Right(rst!f1, 11)
         [frmSub_sra].Form![Sanf] = DLookup("Sanf", "[alsnaf]", "[id_sanf]='" & Right(rst!f1, 11) & "'")
         [frmSub_sra].Form![Alkmiah] = xkamiah 'Right(rst!f1, InStr(1, rst!f1, " "))
         [frmSub_sra].Form![äÕ63] = xprix
         [frmSub_sra].Form![äÕ67] = Replace(xkhasm, "%", "")
         [frmSub_sra].Form![Asafi] = xsafi 'DLookup("Price_Sales", "[alsnaf]", "[id_sanf]='" & Right(rst!f1, 11) & "'")
         [frmSub_sra].Form![mjmo] = xtotal
       
       End If
       rst.MoveNext
    Next i

و هذا المرفق بعد التعديل

 

الاستاذصالح حمادي.rar

  • Thanks 1
قام بنشر

بارك الله فيك استاذي الغالي :fff::fff::fff:@صالح حمادي

ربنا يعطيك الصحه والعافيه جميل جدا 

لاتتاسف يالغالي انت صاحب جميل ان اعتذر منك كنت مسافر يوم طلبت التقرير تاخرت عليك 

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

على كل حال الف الف شكر اليك  هذا هو مطلوبي:fff::fff::fff:

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information