ترحيل من شيت لشيت اخر

[حسن البدوي]

السلام عاليكم اخوتي في الله 

ارجو المساعدة

توضيح داخل الملف فاتورة بيع وفاتورة توريد

كل صنف عندنا وله عدة مقاسات مختلفه 

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

اما في فاتورة البيع ينقص من المخزن 

وشكرا مقدما

المخزن.xlsx

[احمدزمان]

و عليكم السلام و رحمة الله وبركاته

جرب توريد للمخزن في المرفق

لعله المطلوب

Sub ADDIN01()
Dim FS As Worksheet, TS As Worksheet
Dim Q1
Set FS = Sheets(ActiveSheet.Name)
Set TS = Sheets("المخزن")

For FR = 5 To 30
Q1 = FS.Cells(FR, 6).Value
Q2 = FS.Cells(FR, 4) & "*" & FS.Cells(FR, 5)
Q3 = FS.Cells(FR, 7).Value
For TR = 3 To 999
If TS.Cells(TR, 2) = Q1 Then
For TC = 3 To 33
If TS.Cells(2, TC) = Q2 Then
TS.Cells(TR, TC) = TS.Cells(TR, TC) + Q3
GoTo 9
End If
Next 'TC
End If
Next 'TR
9 Next ' FR
End Sub

المخزنAZ.xlsm

[احمدزمان]

نفس الكود السابق
انسخة ثم الصقه ثم غير اسم الكود 

ثم

علامة + الوحيدة الموجودة في الكود استبدلها الى - 

ثم اربط الكود بزر الفاتورة للبيع .... مرفق ملف

المخزنAZ02.xlsm

[حسن البدوي]

اريد كود البيع ايضا

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

وربنا يجعله في ميزان حسناتك يا اخي 

[محمد يوسف]

استاذنا  احمدزمان جزاك الله خيرا

شكرا لك علي هذا الكود الاكثر من رائع

انا كنت عايز الكود دة من زمان ولكن الحمد الله حضرتك  لبيت لي طلبي الان

ممكن بعد اذنك حضرتك  توفقة ان يعمل مع برنامجي 

شكرا لابداعك واسأل الله العلي القدير ان يجزيك به خيرالجزاء

‫البرنامج 1-7-2020 - نسخة (2).xls

[محمد يوسف]

المطلوب  تشغيل هذا الكود علي برنامجي

Sub ADDIN01()
Dim FS As Worksheet, TS As Worksheet
Dim Q1
Set FS = Sheets(ActiveSheet.Name)
Set TS = Sheets("المخزن")

For FR = 5 To 30
Q1 = FS.Cells(FR, 6).Value
Q2 = FS.Cells(FR, 4) & "*" & FS.Cells(FR, 5)
Q3 = FS.Cells(FR, 7).Value
For TR = 3 To 999
If TS.Cells(TR, 2) = Q1 Then
For TC = 3 To 33
If TS.Cells(2, TC) = Q2 Then
TS.Cells(TR, TC) = TS.Cells(TR, TC) + Q3
GoTo 9
End If
Next 'TC
End If
Next 'TR





-------------------------------------
Sub ADDIN01()
Dim FS As Worksheet, TS As Worksheet
Dim Q1
Set FS = Sheets(ActiveSheet.Name)
Set TS = Sheets("المخزن")

For FR = 5 To 30
Q1 = FS.Cells(FR, 6).Value
Q2 = FS.Cells(FR, 4) & "*" & FS.Cells(FR, 5)
Q3 = FS.Cells(FR, 7).Value
For TR = 3 To 999
If TS.Cells(TR, 2) = Q1 Then
For TC = 3 To 33
If TS.Cells(2, TC) = Q2 Then
TS.Cells(TR, TC) = TS.Cells(TR, TC) + Q3
GoTo 9
End If
Next 'TC
End If
Next 'TR
9 Next ' FR
End Sub
Sub ADDIN02()
Dim FS As Worksheet, TS As Worksheet
Dim Q1
Set FS = Sheets(ActiveSheet.Name)
Set TS = Sheets("المخزن")

For FR = 5 To 30
Q1 = FS.Cells(FR, 6).Value
Q2 = FS.Cells(FR, 4) & "*" & FS.Cells(FR, 5)
Q3 = FS.Cells(FR, 7).Value
For TR = 3 To 999
If TS.Cells(TR, 2) = Q1 Then
For TC = 3 To 33
If TS.Cells(2, TC) = Q2 Then
TS.Cells(TR, TC) = TS.Cells(TR, TC) - Q3
GoTo 9
End If
Next 'TC
End If
Next 'TR
9 Next ' FR
End Sub


9 Next ' FR
End Sub

 

[احمدزمان]

يا سيدي الفاضل

هذا مفهوم ولكن وضح

تشعله على اي ورقة في ملفك اكثر من 5 اوراق و لم اجد اي ورقة غاتورة او توريد

انته مش راضي تفهمني ختى ايش الي تبغاه

بس شعل الكود على ملفي

طيب اشغله يعمل ايه

ياخذ بيانات من فين و يخطها فين

ان غهم السؤال نصف الاجابه

و الملف الى انته خاطه انا مش فاهم منه حاجه

فاذا توضح طلبك بالظبط و ترتب الملف بشكل يمكن التعامل معاه حينها انا خدامك يا معلم

تخياتي

[محمد يوسف]

استاذي  احمدزمان  

اسف علي عدم التوضيح 

البرنامج وبه الشرح ‫البرنامج 1-7-2020 - نسخة (2).xls

شكرا لحضرتك وجزاك الله خيرا

[احمدزمان]

السلام عليكم و رحمة الله وبركاته

تم اضافة عمود للمقاس

تم عمل قائمة منسدلة للصنف

تم عمل قائمة منسدلة للمقاس

في g1 تم اضافة دالة للبحث عن كلمة بيع في نوع الفاتورة

اذا وجد بيع - يقوم بخصم الكمايات

لا يوجد بيع يقوم باضافة الكميات

فقط زر واحد للعمليات اضافة او خصم حسب نوع الفاتورة

مع التحية

_البرنامج 1-7-2020 - نسخة (2).xls

[محمد يوسف]

استاذنا الكبير  احمدزمان  جزاك الله خيرا

هذا ممتاذ  وهذا هو المطلوب 

والان ليه طلب اخير بخصوص هذا  البرنامج هل يوجد كود او طريقة لتكبير حجم الخط داخل القائمة المنسدله بحيث اتمكن من اختيار الصنف  مع الحفاظ علي حجم الشيت كما هو 

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

وان يجعل عملك في ميزان حسناتك اللهم امين يارب العالمين

 

[Ali Mohamed Ali]

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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo Skipper
    Dim x As Long
    
    x = 100
    If Target.Validation.Type = xlValidateList Then x = 130
Skipper:
    ActiveWindow.Zoom = x
End Sub

_البرنامج 1-7-2020 - نسخة (2) (1).xls