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



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





السلام عليكم - تعديل على كود ترحيل بيانات

السلام عليكم - تم اضافة خانات جديد الى الفاتورة وعملت جاهدا أن اعدل على الكود تبقى خانات لا ترحل تم اضافة خانات جديد ..



13-12-2017 01:48 مساء
ابوعبدالواجد
menu_open
عضو مشارك
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 6
المشاركات : 46
الجنس : ذكر
تاريخ الميلاد : 7-1-1967
يتابعهم : 0
يتابعونه : 1
قوة السمعة : 31
الاعجاب : 9
 offline 

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

تم اضافة خانات جديد اذا كانت عدد الدفعات (7) اصبحت (12) دفعة

المشكلة عند الضغط على زر الترحيل ترحل البيانات عدا (
رمز المادة اسم المادة سعر المادة الكمية المباعة المبلغ تاريخ الشراء اسم العميل

اذا الترحيل يكون من الفاتورة الى شيت اقساط + نقد مع العلم تم تغيير خانة (رقم الفاتورة ) من خانة Y الى خانة AJ  في شيت (اقساط)
ممكن مساعدتي في حل الاشكال
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب
 
 
  تعديل على الفاتورة - الترحيل.rar   تحميل rar مرات التحميل :(12)
الحجم :(355.803) KB







13-12-2017 06:14 مساء
مشاهدة مشاركة منفردة [1]
محمود ابو الدهب
menu_open
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 14
المشاركات : 672
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 4-7-1990
الدعوات : 56
يتابعهم : 6
يتابعونه : 140
قوة السمعة : 2382
الاعجاب : 859
 offline 
look/images/icons/i1.gif السلام عليكم - تعديل على كود ترحيل بيانات
جرب الكود التالى للترحيل بعد ما تم تعديلة اتمنى ان يكون ما ترغب به
 
Sub abo_dahab()
    Dim ws      As Worksheet
    Dim sh1     As Worksheet
    Dim sh2     As Worksheet
    Dim sh      As Worksheet
    Dim str     As String
    Dim LR      As Long
    Dim i       As Long
    Dim j       As Long
    Dim k       As Long

    Application.ScreenUpdating = False
        Set ws = Sheets("فاتورة")
        Set sh1 = Sheets("نقد")
        Set sh2 = Sheets("اقساط")
    
        str = ws.Range("C2").Value
        If str = "نقد" Then
            Set sh = sh1
        ElseIf str = "أقساط" Or str = "اقساط" Then
            Set sh = sh2
        Else
            Exit Sub
        End If
    
        LR = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
    
        If sh.Name = "اقساط" Then
            sh.Range("H" & LR).Value = ws.Range("B4").Value
            sh.Range("I" & LR).Value = ws.Range("B6").Value
            sh.Range("ac" & LR).Value = ws.Range("a24").Value
            sh.Range("ad" & LR).Value = ws.Range("b24").Value
            sh.Range("ae" & LR).Value = ws.Range("c24").Value
            sh.Range("af" & LR).Value = ws.Range("d24").Value
            sh.Range("ah" & LR).Value = ws.Range("e24").Value
            sh.Range("z" & LR).Value = ws.Range("a22").Value
            sh.Range("aa" & LR).Value = ws.Range("b22").Value
            sh.Range("ab" & LR).Value = ws.Range("c22").Value
            sh.Range("al" & LR).Value = ws.Range("e22").Value
            
            For j = 3 To 14
                If Not IsEmpty(ws.Cells(j, 5).Value) Then
                    sh.Cells(LR, j + k + 7).Value = ws.Cells(j, 5).Value
                    sh.Cells(LR, j + k + 8).Value = ws.Cells(j, 6).Value
                End If
                k = k + 1
            Next j
        End If
    
        For i = 16 To 20
            If ws.Cells(i, 1) = "" Then Exit For
            sh.Range("A" & LR).Resize(1, 6).Value = ws.Cells(i, 1).Resize(1, 6).Value
            sh.Range("G" & LR).Value = ws.Range("B2").Value
            sh.Range("aj" & LR).Value = ws.Range("a2").Value
            sh.Range("j" & LR).Value = ws.Range("e3").Value
            LR = LR + 1
        Next i

    
ws.Range("a2").Value = ws.Range("a2").Value + 1
ws.Range("b2,c2,a16:a20,c16:c20,d16:d20,f16:f20,e3:e14,a22:f22,a24:f24").Select
Selection.ClearContents

    Application.ScreenUpdating = True
MsgBox "Done...", 64

End Sub

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


تقبل تحياتى وتقديرى 


تم تحرير المشاركة بواسطة :محمود ابو الدهب
بتاريخ:13-12-2017 06:19 مساء


أثارت هذه المشاركة إعجاب: ابوعبدالواجد، malik،


توقيع :محمود ابو الدهب
لى عظيم الشرف بالانضمام لهذا الصرح العظيم
وكم أتمنى من الله
ان يعيننى ويعلمنى من علمة الواسع فهو ولي ذالك وهو على كل شي قدير

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


13-12-2017 07:29 مساء
مشاهدة مشاركة منفردة [2]
ابوعبدالواجد
menu_open
عضو مشارك
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 6
المشاركات : 46
الجنس : ذكر
تاريخ الميلاد : 7-1-1967
يتابعهم : 0
يتابعونه : 1
قوة السمعة : 31
الاعجاب : 9
 offline 
look/images/icons/i1.gif السلام عليكم - تعديل على كود ترحيل بيانات
تسلم اخوي واستاذي - اشكرك

تمام

أثارت هذه المشاركة إعجاب: محمود ابو الدهب،




13-12-2017 07:33 مساء
مشاهدة مشاركة منفردة [3]
محمود ابو الدهب
menu_open
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 14
المشاركات : 672
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 4-7-1990
الدعوات : 56
يتابعهم : 6
يتابعونه : 140
قوة السمعة : 2382
الاعجاب : 859
 offline 
look/images/icons/i1.gif السلام عليكم - تعديل على كود ترحيل بيانات
تسلم 



توقيع :محمود ابو الدهب
لى عظيم الشرف بالانضمام لهذا الصرح العظيم
وكم أتمنى من الله
ان يعيننى ويعلمنى من علمة الواسع فهو ولي ذالك وهو على كل شي قدير

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



المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
رمضان مبارك عليكم وعلى المشرفين والاعضاء والزوار زيد2017
3 169 محمد حسن المحمد
السلام عليكم : نقل عدة خلايا (ارقام) في خلية واحد محمد لؤي
6 474 محمد لؤي
السلام عليكم bahaa
2 192 YasserKhalil
السلام عليكم ايها الاساتذه الكرام ارجو المساعده Salamco
3 289 YasserKhalil
السلام عليكم : اعطاء لكل عميل رقم فاتورة تلقائيا حارثة ابو زيد1
14 1191 الصقر

الكلمات الدلالية
السلام ، عليكم ، تعديل ، ترحيل ، بيانات ،


 







اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.



الساعة الآن 03:28 مساء

أعلن هنا
أعلن هنا
أعلن هنا