ترحيل البيانات من USER_FORM الي ورقة العمل

[ABDESLEM]

السلام عليكم ورحمة الله و بركاته 

اولا الشكر كل الشكر للقائمين على هدا المنتدى الرائع و المفيد 

الرجاء افادتي في كود لنقل حقول USER_FORM الى ورقة العمل 

بنسبة لحقل اليوم و الوقت غير قابلة للتغيير تاريخ اليوم و الوقت المرحلة فيه المعلومات 

كلما اضفت صطرا في ورقة العمل يتم حفظ الورقة

لكم الشكر سلفا 

[محمد هشام.]

ارفق ملفك اخي الكريم

[ABDESLEM]

شكرا سيد محمد هشام على الاهتمام 

VBA.xlsm

[محمد هشام.]

تفضل اخي جرب هدا بعد إلغاء ارتباط Combobox (PREPARATEURS) من اعدادات اليوزرفورم  كما في الملف المرفق 

Private Sub UserForm_Initialize()
Set f = Sheets("PREPARATEUR ")
 Set d = CreateObject("Scripting.Dictionary")
  a = f.Range("A2:A" & f.[A65000].End(xlUp).Row)
  For i = LBound(a) To UBound(a)
    If a(i, 1) <> "" Then d(a(i, 1)) = ""
  Next i
  Me.PREPARATEURS.List = d.keys
  Me.DATES.Value = Date
  Me.HEURS.Value = Format(Now, "hh:mm:ss")
End Sub
'*****************************
Private Sub AJOUTER_Click()
Dim tbl As ListObject
Dim arr, lr As Long, lige As Range, cmb()
Set tbl = Range("LISTE_DE_BL").ListObject

arr = Array(DATES.Value, HEURS.Value, _
        Me.BLS.Value, Me.PREPARATEURS.Value)

Set lige = tbl.ListColumns(1).Range.Find(What:="*", _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
     lige.Offset(1).Resize(1, 4).Value = arr
     Me.BLS = "": Me.PREPARATEURS = ""
     ThisWorkbook.Save
     UserForm_Initialize
End Sub

احتمالات واردة

If Me.BLS.Value = "" Then: MsgBox "Please Enter N°BL", vbCritical: BLS.SetFocus: Exit Sub

If Me.PREPARATEURS.Value = "" Then _
MsgBox "Please Enter a Name PREPARATEURS", vbCritical: PREPARATEURS.SetFocus: Exit Sub

 

 'حقل اليوم و الوقت غير قابلة للتغيير
        Me.DATES.Locked = True
        Me.HEURS.Locked = True

 

 

VBA V2.xlsm

تم تعديل أغسطس 20 بواسطه محمد هشام.