ترحيل بيانات الفاتورة الى صفحة و تفاصيل الفاتورة الى صفحة اخرى

[رضا-ابو مريم]

السلام عليكم

برجاء التعديل على المرفق بحيث يتم ترحيل راس الفاتورة الى saleH

و تفاصيل الفاتورة الى saleT

و شكرا

Mall_5.rar

[سليم حاصبيا]

الاستاذ رضى /بعد السلام

اليك الحل

Mall_5.rar

[رضا-ابو مريم]

الاستاذ /سليم

عاجز عن الشكر

انا اريد ترحيل عن طريق الفورم فى شيت 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

[حمادة عمر]

السلام عليكم

الاخ الكريم / 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

[حمادة عمر]

وبرجاء الاطلاع علي الرابط التالي

لتغيير الاسم الي العربية ( طبقا لسياسة وشروط المنتدي ) ولزيادة التواصل .... برجاء الاطلاع علي الموضوع

http://www.officena....showtopic=41520

 

==============
الادارة
==============

[رضا-ابو مريم]

الاخ الكريم حمادة عمر السلام عليكم

عاجز عن الشكر و الله ذلك كل ما اريدة  بالتمام  و جزاك الله خير عنى  وعن كل من اساعدهم بهذ العمل

[حمادة عمر]

السلام عليكم

الاخ الكريم / Mr.reda

بارك الله فيك

الحمد لله ان توصلت لما تريد

جزاك الله خيرا

وتقبل خالص تحياتي

[رضا-ابو مريم]

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

[رضا-ابو مريم]

للرفع

[رضا-ابو مريم]

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

[رضا-ابو مريم]

للرفع

[رضا-ابو مريم]

للرفع