رضا-ابو مريم قام بنشر يونيو 6, 2014 مشاركة قام بنشر يونيو 6, 2014 السلام عليكم برجاء التعديل على المرفق بحيث يتم ترحيل راس الفاتورة الى saleH و تفاصيل الفاتورة الى saleT و شكرا Mall_5.rar رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر يونيو 6, 2014 مشاركة قام بنشر يونيو 6, 2014 الاستاذ رضى /بعد السلام اليك الحل Mall_5.rar رابط هذا التعليق شارك More sharing options...
رضا-ابو مريم قام بنشر يونيو 6, 2014 الكاتب مشاركة قام بنشر يونيو 6, 2014 الاستاذ /سليم عاجز عن الشكر انا اريد ترحيل عن طريق الفورم فى شيت 3 يوجد زر امر يفتح فورم فى هذا الفوم يوجد بيانات فى راس الفورم و بيانات فى التفاصيل و كل ما اريدة ترحيل راس الفاتورة (رقم الفاتورة +تاريخ+العميل الخ) الى شيت saleH و تفاصيل الفاتورة الى (رقم الصنف و اسم الصنف الخ ) الى saleT انا استخدم الكود التالى و لكن لا يعمل 'زر تسجيل Dim Ary Dim LR As Long Dim LR1 As Long Dim Adr As String Dim r, c As Integer Dim r1, C1 As Integer '================= SAMA2 = MsgBox("سيتم تسجيل البيانات الموجودة بالفاتورة ؟هل انت متأكد من اجراء هذه العملية", vbYesNo) If SAMA2 = vbYes Then If Me.TxtInvNo = "" Or Me.TxtIndate = "" Or Me.TxtMonthCod = "" Or Me.ComDocNo = "" Or Me.ComDocType = "" Or Me.TxtcustNo = "" Or Me.Comcustn = "" Or Me.Comcustn = "" Or Me.txtstoNo = "" Or Me.ComStoN = "" Then 'Exit Sub MsgBox "اكمل البيانات الغير مسجلة اعلي الفاتورة اولا", vbMsgBoxRight, "نقص في البيانات !!!" Exit Sub Else Ary = Array(Me.TxtInvNo.Value, Me.TxtIndate.Value, Me.ComDocNo.Value, Me.ComDocType.Value, Me.txtstoNo.Value, Me.ComStoN.Value, Me.TxtcustNo.Value, Me.Comcustn.Value, Me.TxtGtotal.Value, Me.Txtsaletax.Value, Me.txtGtax.Value, Me.txtDam.Value, Me.TXTNETTOTAL.Value, Me.txtTafkit.Value, Me.TxtMonthCod.Value) '=============================== With Sheet1 LR = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 End With Sheet1.Range("A" & LR).Cells(1, 1).Resize(1, 15).Value = Ary '=============================== With Sheet2 LR1 = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 End With For r = 1 To 15 Adr = Cells(r, 1).Address(0, 0) If Len(Trim(Me.Controls(Adr))) Then For c = 1 To 8 Adr = Cells(r, c).Address(0, 0) Sheet2.Range("A" & LR1).Cells(r, c).Value = Me.Controls(Adr).Value Next End If Next '================ 'kh_New '================ End If MsgBox "!! تم تسجيل بيانات الفاتورة.. بنجاح " Else MsgBox "!! لم يتم تسجيل البيانات" End If رابط هذا التعليق شارك More sharing options...
حمادة عمر قام بنشر يونيو 7, 2014 مشاركة قام بنشر يونيو 7, 2014 السلام عليكم الاخ الكريم / Mr.reda بارك الله فيك بعد اذن اخي الحبيب / سليم حاصبيا ... جزاه الله خيرا قم باستخدام الكود التالي في زر التسجيل لتنفيذ المطلوب Private Sub CommandButton1_Click() Dim LR, LR1 As Long Dim Adr As String Dim r, c As Integer Dim ws, ws2 As Worksheet '================= SAMA = MsgBox("ÓíÊã ÊÓÌíá ÇáÈíÇäÇÊ ÇáãæÌæÏÉ ÈÇáÝÇÊæÑÉ ¿åá ÇäÊ ãÊÃßÏ ãä ÇÌÑÇÁ åÐå ÇáÚãáíÉ", vbYesNo) If SAMA = vbYes Then If Me.TxtInvNo = "" Or Me.TxtIndate = "" Or Me.TxtMonthCod = "" _ Or Me.ComDocNo = "" Or Me.ComDocType = "" Or Me.TxtcustNo = "" _ Or Me.Comcustn = "" Or Me.Comcustn = "" Or Me.txtstoNo = "" Or Me.ComStoN = "" Then 'Exit Sub MsgBox "Çßãá ÇáÈíÇäÇÊ ÇáÛíÑ ãÓÌáÉ ÇÚáí ÇáÝÇÊæÑÉ ÇæáÇ", vbMsgBoxRight, "äÞÕ Ýí ÇáÈíÇäÇÊ !!!" Exit Sub Else '============= 'saleH ÎÇÕ ÈÇáÌÒÁ ÇáÚáæí æÊÑÍíáå Çáí Set ws = Worksheets("saleH") LR = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row ws.Cells(LR, 1).Value = Me.TxtInvNo.Value ws.Cells(LR, 2).Value = Me.TxtIndate.Value ws.Cells(LR, 3).Value = Me.ComDocNo.Value ws.Cells(LR, 4).Value = Me.ComDocType.Value ws.Cells(LR, 5).Value = Me.txtstoNo.Value ws.Cells(LR, 6).Value = Me.ComStoN.Value ws.Cells(LR, 7).Value = Me.TxtcustNo.Value ws.Cells(LR, 8).Value = Me.Comcustn.Value ws.Cells(LR, 9).Value = Me.TxtGtotal.Value ws.Cells(LR, 10).Value = Me.Txtsaletax.Value ws.Cells(LR, 11).Value = Me.txtGtax.Value ws.Cells(LR, 12).Value = Me.txtDam.Value ws.Cells(LR, 13).Value = Me.TXTNETTOTAL.Value ws.Cells(LR, 14).Value = Me.txtTafkit.Value ws.Cells(LR, 15).Value = Me.TxtMonthCod.Value '================================ 'saleT ÎÇÕ ÈÇáÌÒÁ ÇáÓÝáí æÊÑÍíáå Çáí Set ws2 = Worksheets("saleT") With ws2 LR1 = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 End With For r = 1 To 15 Adr = Cells(r, 1).Address(0, 0) If Len(Trim(Me.Controls(Adr))) Then For c = 1 To 8 Adr = Cells(r, c).Address(0, 0) ws2.Range("A" & LR1).Cells(r, c).Value = Me.Controls(Adr).Value Next End If Next sama_Clear '===================== End If MsgBox "!! Êã ÊÓÌíá ÈíÇäÇÊ ÇáÝÇÊæÑÉ.. ÈäÌÇÍ " Else MsgBox "!! áã íÊã ÊÓÌíá ÇáÈíÇäÇÊ" End If End Sub ارجو ان يفي بطلبك اخي الكريم تقبل خالص تحياتي Mall_sama.rar 1 رابط هذا التعليق شارك More sharing options...
حمادة عمر قام بنشر يونيو 7, 2014 مشاركة قام بنشر يونيو 7, 2014 وبرجاء الاطلاع علي الرابط التالي لتغيير الاسم الي العربية ( طبقا لسياسة وشروط المنتدي ) ولزيادة التواصل .... برجاء الاطلاع علي الموضوع http://www.officena....showtopic=41520 ============== الادارة ============== رابط هذا التعليق شارك More sharing options...
رضا-ابو مريم قام بنشر يونيو 7, 2014 الكاتب مشاركة قام بنشر يونيو 7, 2014 الاخ الكريم حمادة عمر السلام عليكم عاجز عن الشكر و الله ذلك كل ما اريدة بالتمام و جزاك الله خير عنى وعن كل من اساعدهم بهذ العمل رابط هذا التعليق شارك More sharing options...
حمادة عمر قام بنشر يونيو 7, 2014 مشاركة قام بنشر يونيو 7, 2014 السلام عليكم الاخ الكريم / Mr.reda بارك الله فيك الحمد لله ان توصلت لما تريد جزاك الله خيرا وتقبل خالص تحياتي رابط هذا التعليق شارك More sharing options...
رضا-ابو مريم قام بنشر يوليو 10, 2014 الكاتب مشاركة قام بنشر يوليو 10, 2014 الاخ حمادة عمر ممكن برمجة زر بحث و تعديل و حذف طبقا للطريقة السابقة فى زر تسجيل و شكرا رابط هذا التعليق شارك More sharing options...
رضا-ابو مريم قام بنشر يوليو 12, 2014 الكاتب مشاركة قام بنشر يوليو 12, 2014 للرفع رابط هذا التعليق شارك More sharing options...
رضا-ابو مريم قام بنشر يوليو 14, 2014 الكاتب مشاركة قام بنشر يوليو 14, 2014 الاخ حمادة عمر ممكن برمجة زر بحث و تعديل و حذف طبقا للطريقة السابقة فى زر تسجيل و شكرا رابط هذا التعليق شارك More sharing options...
رضا-ابو مريم قام بنشر يوليو 18, 2014 الكاتب مشاركة قام بنشر يوليو 18, 2014 للرفع رابط هذا التعليق شارك More sharing options...
رضا-ابو مريم قام بنشر يوليو 31, 2014 الكاتب مشاركة قام بنشر يوليو 31, 2014 للرفع رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.