حسين مامون

جرب المرفق
ادخل رقم الصنف واضغط زر ادخال على لوحة المفاتيح
ملفك لا يفتح عندي المرفق هو فقط تجربة لما شرحت في مشاركتك
test.xlsm

تفضل
اظهار البيانات من اليست بوكس الى التكست بوكس.xlsm

ضع هذا الماكرو في مديول
غير اسم الشيت الديون الى data1
واسم الشيت العملاء data2
او غير رهما في الماكرو الى العربي في الصف الثالث والرابع
Sub test() Dim ws As Worksheet Dim ws2 As Worksheet Set ws = Sheets("data1") Set ws2 = Sheets("data2") Dim lr, lr2, x, xx, x1, x2, y Application.ScreenUpdating = False lr = ws.Cells(Rows.Count, "c").End(3).Row lr2 = ws2.Cells(Rows.Count, "b").End(3).Row For xx = 2 To lr2 For x = 6 To lr If ws2.Cells(xx, "b").Text = ws.Cells(x, "c") Then x1 = x1 + Val(ws.Cells(x, "e")) x2 = x2 + Val(ws.Cells(x, "g")) End If ws2.Cells(xx, "c") = x1 - x2 Next x1 = 0 x2 = 0 Next Application.ScreenUpdating = True End Sub  

هذه تجربة ولكن ليس في ملفك 
ملفك لايريد ان يفتح عندي
 
Book1.xlsm
او ضع هذا الكود في حدث الفورم
Private Sub UserForm_Initialize() If Label1.Caption = "" Then TextBox1.Visible = False Else TextBox1.Visible = True End If End Sub  

جرب المرفق
my_test.rar

ضع هذا الكود في TEXTBOX3
ادخل الاسم المراد وانقر زر ادخال على لوحة المفاتيح
Private Sub textbox3_AfterUpdate() Dim ws As Worksheet Set ws = Sheets("مزارعين") Dim lr Dim x lr = ws.Range("b" & Rows.Count).End(xlUp).Row For x = 2 To lr If textbox3.Text = ws.Cells(x, 2) Then textbox2.Value = ws.Cells(x, 1) Exit For End If Next x End Sub  

بعد اذن الاستاذ هذا الكود يطبع جميع الشيتات باستثناء شيت DATA ويمكنك تعديله حسب المدى المطلوب
sub test 'كود طباعة جميع الشيتات dim ws as worksheet dim sh as worksheet: set sh = sheets("DATA") ' الشيت المستثنى من الطباعة Dim lr As Long For Each ws In Sheets lr = ws.Range("a" & Rows.Count).End(xlUp).Row If ws.Name = "DATA" Then GoTo 1 ' الشيت داتا سميه ما شئت ولك غيره في السطر الثاني و السادس ws.Range("a1:g" & lr).PrintOut 1: Next ws end sub  
 

تفضل ولاكن لايمكن العمل على التخمين بدون رفع ملف العمل
 
Book1 (Recovered).xlsm

تفضل جرب المرفق
 
اضافة بيانات لليست عن طريق تكستات بزر اضافة.xls

بعد اذن الاساتذة  ربما هذا الكود يفي بالغرض
 
تقسيم مبلغ الدفع حسب الشرط.xlsm

جرب حذف الجزء المحاط بالاحمر في الصورة  ستجده في حدث textbox_change

عليكم السلام
 فك الضغط وضع المجلد في برتشين D 
 
back1.rar

احفظ لوكو في فولدر الصور

ثم اذهب الى الاكسيل

ثم header / footer -------
ثم custom header

ثم انقر في  center section
eثم انقر على رمز الصورة واختر الفولدر اللي فيه الصورة وانقر عليها
 
 

ثم magns
قم بتعديل الهامش العلوي حتى 3.5 سم
ثم OK
 

قم بتعديل الكود او انسخ الجزء بين السطرين فقط واضفه للكود عندك 
 
Private Sub CommandButton1_Click() ' saveas_facture() Dim wx As Workbook Set wx = Workbooks("ÝÇÊæÑÉ") Dim ws As Worksheet Set ws = wx.Sheets("invoice") Dim wss As Worksheet Set wss = wx.Sheets("sheet1") Dim DT Dim Nam Dim lr As Long Application.ScreenUpdating = False Application.EnableEvents = False lr = wss.Range("a" & Rows.Count).End(xlUp).Row + 1 DT = ws.Range("e5") & Format(Now(), "dd-mm-yyyy hh mm ss") With ws ' .Copy ' .UsedRange = .UsedRange.Value Application.DisplayAlerts = False ' Nam = "d:\back\backup\ÝÇÊæÑÉ" & DT & ".xlsx" Nam = .Range("e5") & " " & Format(Now(), "dd mm yyyy hh mm ss") ThisWorkbook.SaveCopyAs Filename:="D:\back\Backup\" & Nam & ".xlsm" ' ActiveWorkbook.SaveAs Nam, FileFormat:=xlOpenXMLWorkbook '========================================= If ws.[f5].Text = "اجل" Then wss.Range("a" & lr).Value = Nam wss.Range("a" & lr).Font.Color = 255 Else: wss.Range("a" & lr).Value = Nam End If '======================================== ' ActiveWorkbook.Close False End With Application.DisplayAlerts = True Application.ScreenUpdating = True Application.EnableEvents = True MsgBox "Êã ÍÝÙ äÓÎÉ ÈÇÓã " & DT & " ", vbInformation End Sub  

جرب المرفق
 
الصندوق2019 (2).xlsm

جرب المرفق
back.rar

اخي الكريم  قم بانشاء مجلد factur في Documents
انا جربته وهو 100/100
هذه صورة داخل مجلد factur بعد تنفيذ الكود
ان لم يعمل ارسل صورة للمستندات او documents

المكتبة الصوتية.xlsm

ضع الكود في حدث اغلاق الملف
Private Sub Workbook_BeforeClose(Cancel As Boolean) With Sheets("main") .[d3] = Val(.[d3]) + 1 .[d4] = Format(Now(), "dd-mm-yyyy hh:mm:ss") End With End Sub  

جرب هذا المرفق
back.rar

اخي الكريم 
ضع اسماؤها في العمود A كما هي  
 
 
 
back.rar

جرب المرفق 
البحث بالكود  وان تحقق الشرط  تظهر نتيجة في اللسيت  ثم تحديد الحركة التي تريد تعديلها  ثم عدل التاريخ و المبلغ كما تشاء وانقر زر تعديل
تحياتي 
حركة السلف.xlsm

ادخل بياناتك في اي منطقة وستجدها ان شاء الله اترحلت
تحياتي
المناطق (3).xlsm

طلبك غير واضح يا اخي 
في مشاركتك الاولى قلت ما يلي
           
لسلام عليكم 
اريد فتح الفورم على طول بدون فتح الاكسل ووضع حماية على الاكسل حتى لا يتم التعديل كلمة المرور 0505442208 ما عرفت ازيلها
1441.xlsm

ربما يكون هذا سبب المشكلة عندك  هوامش الصفحات في الجهاز الذي تلصق فيه البيانات
قم بتعديل الهوامش من خلال page setup
 
 
 

علكم السلام
هذه تجربة متواضعة يمكنك العمل عليها  ان اعجبتك 
 
التنقل بين الصفحات.xlsm