mody200 قام بنشر يوليو 23 مشاركة قام بنشر يوليو 23 (معدل) Private Sub b_recup_Click() On Error Resume Next Dim Y As Date Dim X As Integer Set fS = Sheets("تصدير بيانت اكسيل") For X = 0 To ListBox1.ListCount - 1 Ligs = fS.Range("A" & Rows.Count).End(xlUp)(2).Row fS.[A2:l10000].ClearContents r1 = Text_count.Value Sheet5.Range("a2:L3999").ClearContents hrd1 = Array("رصيد اول مدة") fS.[c2].Resize(1, 1) = hrd1 fS.Range("f2") = ("بيان رصيد اول مدة بتاريخ هذا اليوم") fS.Range("g2") = Text_count fS.Range("i2") = Text_count fS.Range("b2") = Format(DateAdd("d", -1, CDate(Me.DateMini.Value)), "dd/mm/yyyy") a = Me.ListBox1.List fS.[A3].Resize(UBound(a) + 1, UBound(a, 2) + 1) = a c = 0 For c = 1 To Irow fS.Cells(1, c) = Range(NomTableau).Offset(-1).Item(1, c) Next fS.Range("F" & Ligs) = ("اجمالى") fS.Range("g" & Ligs) = TextBox3 fS.Range("h" & Ligs) = TextBox2 fS.Range("i" & Ligs) = TextBox1 Next X ' f2.Cells.EntireColumn.AutoFit fS.Columns(13).ClearContents MsgBox "تم تصدير البيانات بنجاح" Unload Me Set Rng = fS.Range("A1").CurrentRegion fS.PageSetup.PrintArea = Rng.Address fS.PrintPreview fS.Zoom End Sub Copy of كشف حساب عميل & كارت صنف.xlsm تم تعديل يوليو 23 بواسطه mody200 رابط هذا التعليق شارك More sharing options...
lionheart قام بنشر يوليو 24 مشاركة قام بنشر يوليو 24 The code is already OK as it exports data from the listbox to the worksheet Just comment out those two lines For X = 0 To ListBox1.ListCount - 1 Next X as I don't see any need to loop through the items of the listbox 2 رابط هذا التعليق شارك More sharing options...
mody200 قام بنشر يوليو 24 الكاتب مشاركة قام بنشر يوليو 24 انه يقوم بتصدير البينات بالفعل ولاكن يوجد فراغات بين البيانات وبين اجمالى القيم واجمالى قيم كل عمود كما هو موضح فى الصورةاريد القيم تكون فى اخر البيانات بدون فراغات رابط هذا التعليق شارك More sharing options...
mahmoud nasr alhasany قام بنشر يوليو 24 مشاركة قام بنشر يوليو 24 (معدل) جميل حقا تم تعديل يوليو 24 بواسطه mahmoud nasr alhasany 1 رابط هذا التعليق شارك More sharing options...
mody200 قام بنشر يوليو 24 الكاتب مشاركة قام بنشر يوليو 24 الرجاء المساعدة بالنسبة للكود والفراغات عند كل عملية تصدير رابط هذا التعليق شارك More sharing options...
mahmoud nasr alhasany قام بنشر يوليو 24 مشاركة قام بنشر يوليو 24 (معدل) Private Sub b_recup_Click() On Error Resume Next Dim Y As Date Dim X As Integer Set fS = Sheets("تصدير بيانات اكسيل") fS.Rows("3:3999").Select Selection.Delete Shift:=xlUp fS.[a2:m3999].ClearContents r1 = Text_count.Value Sheet3.Range("a2:m3999").ClearContents hrd1 = Array("رصيد اول مدة") fS.[c2].Resize(1, 1) = hrd1 fS.Range("f2") = ("بيان رصيد اول مدة بتاريخ هذا اليوم") fS.Range("g2") = Text_count fS.Range("i2") = Text_count fS.Range("b2") = Format(DateAdd("d", -1, CDate(Me.DateMini.Value)), "dd/mm/yyyy") a = Me.ListBox1.List fS.[A3].Resize(UBound(a) + 1, UBound(a, 2) + 1) = a c = 0 For c = 1 To Irow fS.Cells(1, c) = Range(NomTableau).Offset(-1).Item(1, c) Next Ligs = fS.Range("A" & Rows.Count).End(xlUp)(2).Row fS.Range("f" & Ligs) = ("اجمالى") fS.Range("g" & Ligs) = TextBox3 fS.Range("h" & Ligs) = TextBox2 fS.Range("i" & Ligs) = TextBox1 ' f2.Cells.EntireColumn.AutoFit fS.Columns(13).ClearContents MsgBox "تم تصدير البيانات بنجاح" Unload Me Set Rng = fS.Range("A1").CurrentRegion fS.PageSetup.PrintArea = Rng.Address fS.PrintPreview fS.Zoom End Sub تم عمل المطلوب جرب هذا الكود تم تعديل يوليو 24 بواسطه mahmoud nasr alhasany 1 رابط هذا التعليق شارك More sharing options...
أفضل إجابة محمد هشام. قام بنشر يوليو 25 أفضل إجابة مشاركة قام بنشر يوليو 25 (معدل) تفضل جرب هدا Private Sub b_recup_Click() Dim Cnt As VbMsgBoxResult Dim sht As Worksheet, tbl As ListObject, tblRow As ListRow Set sht = Sheets("تصدير بيانات اكسيل") Set tbl = sht.ListObjects("Table1") Cnt = MsgBox(" تــرحيل البيانات ؟", vbYesNo, sht.Name): If Cnt <> vbYes Then Exit Sub With tbl.DataBodyRange If .Rows.Count > 1 Then .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete End If End With tbl.DataBodyRange.Rows(1).ClearContents Set tblRow = tbl.ListRows.Add tblRow.Range.Resize(Me.ListBox1.ListCount) = Me.ListBox1.List sht.[b2] = Format(DateAdd("d", -1, CDate(Me.DateMini.Value)), "dd/mm/yyyy") sht.[C2] = ("رصيد المدة"): sht.[F2] = ("بيان رصيد أول مدة بتاريخ هذا اليوم") sht.[G2] = Text_count: sht.[I2] = Text_count With sht.Cells(sht.Rows.Count, 6).End(xlUp).Offset(1) .Value = "الإجمالي" .Offset(, 1) = Me.TextBox3.Value .Offset(, 2) = Me.TextBox2.Value .Offset(, 3) = Me.TextBox1.Value End With MsgBox "تم نرحيــل البيانات بنجاح" Unload Me On Error Resume Next Set Rng = sht.Range("A1").CurrentRegion sht.PageSetup.PrintArea = Rng.Address sht.PrintPreview ' answer = MsgBox("طباعــة التقرير ؟", vbQuestion + vbYesNo + vbDefaultButton2, "تأكـــيد") ' If answer = vbYes Then sht.PrintOut End Sub تمت اظافة اكواد تصدير الملف بصيغة Word, Excel, PDF في الملف المرفق Copy of كشف حساب عميل & كارت صنف V5.xlsm تم تعديل يوليو 25 بواسطه محمد هشام. 2 رابط هذا التعليق شارك More sharing options...
mody200 قام بنشر يوليو 25 الكاتب مشاركة قام بنشر يوليو 25 احسنت السيد محمد هشام انت بجد روعه ومنقذ رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان