• اضافة إهداء
    (المعذره .. غير مسموح للزوار بإضافة الإهداءات, الرجاء التسجيل في المنتدى)


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





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

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



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

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

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

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





13-12-2017 06:14 مساء
مشاهدة مشاركة منفردة [1]
محمود ابو الدهب
menu_open
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 14
المشاركات : 454
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 4-7-1990
الدعوات : 56
يتابعهم : 5
يتابعونه : 66
قوة السمعة : 1257
الاعجاب : 446
 Online 
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
المشاركات : 26
الجنس : ذكر
تاريخ الميلاد : 7-1-1967
يتابعهم : 0
يتابعونه : 1
قوة السمعة : 16
الاعجاب : 3
 offline 
look/images/icons/i1.gif السلام عليكم - تعديل على كود ترحيل بيانات
تسلم اخوي واستاذي - اشكرك

تمام

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



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



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

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



المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
السلام عليكم : نقل عدة خلايا (ارقام) في خلية واحد محمد لؤي
6 101 محمد لؤي
السلام عليكم bahaa
2 53 YasserKhalil
السلام عليكم ايها الاساتذه الكرام ارجو المساعده Salamco
3 94 YasserKhalil
السلام عليكم : اعطاء لكل عميل رقم فاتورة تلقائيا حارثة ابو زيد1
14 251 الصقر

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


 







الساعة الآن 08:07 مساء