اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

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

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

وشكرا واسف عى الاطالة

مخزون.xlsm

قام بنشر

تفضل اخي تم اصلاح بعض الاخطاء في الاكواد 

سبب تهنيج الملف هو كود اظهار الساعة على اليوزرفورم  قد تم استبداله بطريقة اخرى  

1) تم تفعيل اكواد يوزرفورم 3 كما طلبت من قبل بطريقتين مختلفتين يمكنك اختيار ما يناسبك.

2) تم تعديل اكواد يوزرفورم 1 لتتماشى مع طريقة اشتغال الملف 

3) تم استبدال معادلة ادراج تاريخ اليوم  في عمود A  بالكود التالي تفاديا لاظهار رسالة  (Circular reference)   

Private Sub Worksheet_Change(ByVal TaFet As Range)
Dim myRng As Range, F As Range, Col As Integer, lr As Long
Set myRng = Intersect(Application.ActiveSheet.Range("B3:B2000"), TaFet)

'Column("A")
 Col = -1
If Not myRng Is Nothing Then
    For Each F In myRng
    If Not VBA.IsEmpty(F.Value) Then
        F.Offset(0, Col).Value = Now
        F.Offset(0, Col).NumberFormat = "dd-mm-yyyy"
    Else
      F.Offset(0, Col).ClearContents
        End If
    Next
End If
End Sub

اكواد يوزرفورم 3  

Dim F, K, WS_Data(), LigneN_Row
Private Sub UserForm_Initialize()
   Set F = Sheet5 'Worksheets("الدخول")
   Set K = F.Range("A3:V" & F.[A65000].End(xlUp).Row)
   WS_Data = K.Value
   Set Réf = CreateObject("Scripting.Dictionary")
   a = F.Range("j3:j" & F.[j65000].End(xlUp).Row)
   For I = LBound(a) To UBound(a)
    If a(I, 1) <> Empty Then Réf(a(I, 1)) = Empty
Next I
WS2 = Réf.keys
  Me.ComboBox1.List = WS2
vidange_Click
Me.TextBox1.SetFocus
ComboBox1 = "*"
Me.N_Row.Visible = False

End Sub
''''''''''''''''''''''''''''''
Private Sub ListBox1_Click()
Me.TextBox1.Value = Me.ListBox1.Column(0)
Me.ListBox1.Visible = False
For I = 1 To UBound(WS_Data)
     If WS_Data(I, 10) = Me.TextBox1.Text Then
        N_linge = I
        Me.N_Row = N_linge + K.Row - 1
     End If
   Next I
Me.TextBox2.Text = WS_Data(N_linge, 10)
'''''''''''''''
' جلب التاريخ والساعة
'Me.TextBox3.Text = WS_Data(N_linge, 1)
'جلب التاريخ فقط
Me.TextBox3.Text = Format(CDate(WS_Data(N_linge, 1)), "MM/DD/YYYY")
''''''''''''''
Me.TextBox4.Text = WS_Data(N_linge, 6)
Me.TextBox5.Text = WS_Data(N_linge, 7)
Me.TextBox6.Text = WS_Data(N_linge, 9)
Me.TextBox7.Text = WS_Data(N_linge, 2)
   Me.ComboBox1 = "*"
   Me.TextBox1 = ""
End Sub
''''''''''''''''''''''''''''
Private Sub TextBox1_Change()
If Me.TextBox1.Text = "" Then
Me.ListBox1.Visible = False
Else
Me.ListBox1.Visible = True
Me.ListBox1.Clear
'------------------------------
Dim K
Set w = Sheet5
K = w.Cells(Rows.Count, 10).End(xlUp).Row
l = 0
For Each c In Range("j3:j" & K)
If c Like TextBox1.Text & "*" Then
ListBox1.AddItem
ListBox1.List(l, 0) = Cells(c.Row, 10).Value
l = l + 1
End If
Next c
End If
Me.ComboBox1 = "*"
End Sub
Private Sub vidange_Click()
For I = 1 To 7
Controls("textbox" & I).Text = Empty
    Next I
Me.ComboBox1 = "*"
End Sub
Private Sub TextBox1_DblClick(ByVal cancel As MSForms.ReturnBoolean)
  If Not iGblInhibitTextBoxEvents Then
  TextBox1.Value = ""
  Me.ComboBox1 = "*"
  End If
End Sub
'''''''''''''''''''''''''''
Private Sub ComboBox1_click()
For I = 1 To UBound(WS_Data)
If WS_Data(I, 10) = Me.ComboBox1.Text Then
        N_linge = I
        Me.N_Row = N_linge + K.Row - 1
     End If
Next I
Me.TextBox2.Text = WS_Data(N_linge, 10)
'''''''''''''''
' جلب التاريخ والساعة
'Me.TextBox3.Text = WS_Data(N_linge, 1)
'جلب التاريخ فقط
Me.TextBox3.Text = Format(CDate(WS_Data(N_linge, 1)), "MM/DD/YYYY")
''''''''''''''
Me.TextBox4.Text = WS_Data(N_linge, 6)
Me.TextBox5.Text = WS_Data(N_linge, 7)
Me.TextBox6.Text = WS_Data(N_linge, 9)
Me.TextBox7.Text = WS_Data(N_linge, 2)
Me.TextBox1.Text = Empty
End Sub

في انتظار ان توافينا بالنتيجة بعد التجربة 

بالتوفيق

 

مخزون V3.xlsm

  • Like 2
قام بنشر

الف شكر استاذي الفاضل على المساعدة جزاك الله كل خير سوف اقوم بالمراجعة وابلغ حضرتك بالنتائج الف شكر

 

السلام عليكم

استاذي الكريم اولا الف شكر على المساعدة واسف على عدم الرد السريع لحدوث مشكلة في الانترنت لدي الملف تمام ولكن عند اختيار اللون من ليست الاختيارات تظهر الالوان ناقصة ثاني وثالث لون وهم مضافين بالفعل في ملف الالوان وهم ابيض 5.5 وابيض 5 وايضا عند ادراج اللاكواد المرسلة في الملف المرسل من حضرتك الاحظ انه يقوم بالبحث ايضا دون معرفة السبب وانا مرسل لسيادتك الملف للمعرفة وشاكر جدا لمساعدة حضرتك 

مخزون V4.xlsm

 

اخي الكريم على يوزرفورم 1 عند اختيار اللون لايوجد لون 5.5 او 5.3 ولاحظت انه عند الغاء جميع الاختيارات من الملف تظهر الالوان وعند اختيار مثلا او لون ابيض 5.8 واقوم بالتسجيل لو فتحت القائمة مرة اخرى لا اجد الالوان كاملة وذلك ايضا يحدث في الملف الاصلي اذا دخلت على الملف قمت بالاضافة يدويا يحدث نفس المشكلة انا اسف اخي الكريم على الاطالة جزاك الله كل خير

 

  • أفضل إجابة
قام بنشر (معدل)

المشكلة أخي ليس من اليوزرفورم المشكلة من مكان جلب البيانات حاول مراجعة المعادلة الموجودة في  ورقة الادخال  عمود CF  . وإعادة ظبط نطاق القوائم المنسدلة.

المهم تم استبدال عمود جلب البيانات الى عمود CK اي اظافة جديدة أو تعديل  قم باظافتها هناك لتظهر معك على الكومبوبوكس 

 

مخزون V5.xlsm

تم تعديل بواسطه محمد هشام.
  • Like 2
قام بنشر

اخي الفاضل 

انا طبقت كل اللي حضرتك ارسلته وكن كما هو الوضع وانا قمت بتوضيح المشكلة في الملف الاصلي الخاص بصفحة الدخول حيث المعادلات غير صحيحة وعند اختيار مثلا اول لون من القائمة واقوم بالتسجيل واريد اختار لون اخر يتم انقاص اللون الذي يسبقه اكيد هناك خطأ لم ادركه ولم استطيع الوصول اليه اتمنى ان اكون اوضحت المطلوب للمساعدة انا متشكر للاهتمام بمساعدتي بارك الله فيك 

مخزون V5.xlsm

قام بنشر (معدل)

 

701855651.png

 

190334394.png

كما ترى تظهر معي جميع الالوان

التوضيح بيانات الكومبوبوكس مستمدة من عمود CK فهي قيم ثابتة لا تتغير

كما لاحظ معادلتك انت عند ادخال البيانات يتم

اختفاء بعض الالوان  لهذا تختفي عندك على القوائم المنسدلة

 

اخي تم الاشتغال والإجابة فقط على طلبك في اول مشاركة وهو حل مشكلة تشغيل اليوزرفورم.

اذا كان لك طلب آخر المرجوا انشاء موضوع جديد بذالك 

 

تم تعديل بواسطه محمد هشام.
  • Like 1
زائر
هذا الموضوع مغلق.
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information