am3h80

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

علي هذا المجهود الرائع

وجعله في ميزان حسناتك

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

ولكني أرغب في الأستفسار  عند تطبيق الأكواد سالفة الذكر لم يتم حفظ الأكواد بVBA كأن لم يتم كتابة الكود نهائياً وفي بعض الأحيان يتم حذف الملف ؟

يرجي توضيح ذلك

مع العلم باني اقوم بحفظ الملف مرة اخري

في ظل التطور التكنولوجي في اغلب الشركات وتوافر البنية التحتية لتكنولوجيا المعلومات ( من أجهزة حاسب ألي وسيرفرات وإيملات وشبكة داخلية مرتبطه بشبكة الانترنت ) ومع توافر وسائل كثيرة لبرمجة النماذج الالكترونية.

وقد فكرت منذ اشهر بتلك الفكرة موضوع حديثكم هذا

فيمكن عمل صفحات نت ديناميكية باي لغة برمجة ويب وتثبيتها علي سيرفر الشركة

ونظرا لتوافر الأجهزة لاغلب الموظفين المربوطة بسرفر واحد مع استخدام برتوكول TCP Fتحديد رقم تعريف لكل جهاز يكون الإعتماد وفقا ip لكل جهاز

ويتم انشاء 3 جداول

جدول لتقديم الطلبات من الموظف

ويتم ترحيل بيانات الطلب الي الجدول المناسب حسب رؤية المدير بالقبول او الرفض

جدول رفض الطلبات من المدير

جدول قبول الطلبات من المدير

مجهود رائع ... جعله الله في ميزان حسناتك

وبالتوفيق دائماً

في ‏١٨‏/‏٠٦‏/‏٢٠١٨ at 06:15, ahmedkamelelsayed0 said:

تختلف علامة (+1)  باختلاف المعادلة  ففي بعض المعادلات مثال Row+1 معناها آخر صف به بيانات ونزول إلى الصف الذي يليه

فينبغي إرفاق المطلوب في ملف لنتمكن من الرد

أحسنت التفسير أستاذنا الفاضل ..... تحياتي

في ‏١٨‏/‏٠٦‏/‏٢٠١٨ at 09:46, سليم حاصبيا said:

تم معالجة الامر

Book_salim.xls

بارك الله فيك علي النشر الطيب

مضي من الدهر 3 سنوات ولكن العمل ما زال

بارك الله فيك ويما نشرت وجعله في ميزان جسناتك

تفضل اخي كما تريد

الله الموفق

update OptionButton.xlsm

تسلم  الايادي ........ عمل رائع ...... بالتوفيق

عزيزي @haitham rasheed

تم عمل تعديل بسيط

تفضل أخي

كارت الصنف.xlsm

عزيزي @alma_fandi

تحت امرك بما أستطيع...

تحياتي واحترامي للمجهود المبذول في تطوير أعمالك

عزيزي @alma_fandi

الكود يعمل بشكل طبيعي عند كتابة اسم المؤسسة في التكست بوكس تظهر المؤسسة المراد البحث عنها

واقترح بان يتم تغيير التكست بوكس إلي كومبو بوكس وتحميل أسماء المؤسسات به حتي يمكن للمستخدم تحديد المؤسسة المرادة دون أي أخطاء إملائية في كتابة اسم المؤسسة

وهذا هو كود تحميل الكومبو بوكس الخاص بالفورمة

    'The Excel workbook and worksheets that contain the data, as well as the range placed on that data
   ' Dim wbBook As Workbook
    Dim WS As Worksheet
    Dim rnData As Range

    'Variant to contain the data to be placed in the combo box.
    Dim vaData As Variant
    'Initialize the Excel objects
    Set WS = ThisWorkbook.Worksheets("sheet1")
    'Set the range equal to the data, and then (temporarily) copy the unique values of that data to the L column.
    With WS
        Set rnData = .Range(.Range("b3"), .Range("b200").End(xlUp))
        rnData.AdvancedFilter Action:=xlFilterCopy, _
                          CopyToRange:=.Range("z1"), _
                          Unique:=True
                'store the unique values in vaData
       vaData = .Range(.Range("z2"), .Range("z200").End(xlUp)).Value
      
    
        'clean up the contents of the temporary data storage
       .Range(.Range("z1"), .Range("z200").End(xlUp)).ClearContents
 
    End With
    'display the unique values in vaData in the combo box already in existence on the worksheet.
    With ComboBox3
        '.Clear
        .List = vaData
        .ListIndex = -1
    End With
   
 

كما اقترح عمل كومبو بوكس أخر يتم إضافة فيه تواريخ أسم المؤسسة المختارة لسهولة الاستخدام

موضوع في غاية الروعة والكنز في التعليم

بارك الله في كل من ساهم في نشر اي كود وجعله في ميزان حسناته

تحياتي للجميع

بارك الله فيك وجعله في ميزان حسناتك استاذنا الفاضل

بنفس اسمي هنا علي اي موقع

جرب وشوف....................
Copy of a1 save ,next privias delete (Autosaved).xls

ir = Cells(Rows.Count, 1).End(xlUp).Row+1

في سطر السابق بمفتاح الحفظ أحذف +1

شوف كده

بالتوفيق

OptionButton.xlsm

جرب الكود ده مع ترتيب اداة optionbutton في كل frame

وجاري عمل حلقة علي الاداة لكي يتم التسجيل التلقائي في الخالية الخاصة بها

 وجاري 

,Private Sub CommandButton1_Click()
Dim x
Dim LR As Long
Dim MX As Double
For x = 1 To x
If Me.OptionButton1.Value = True Then
Dim ws As Worksheet
Dim iRow As Long
Set ws = Worksheets("feuil1")
With Feuil1
    LR = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    MX = WorksheetFunction.Max(.Range("A1:A" & LR))
End With
iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ws.Cells(iRow, 1).Value = MX + 1
ws.Cells(iRow, 2).Value = Me.TextBox1.Value
ws.Cells(iRow, 3).Value = Me.TextBox2.Value
ws.Cells(iRow, 9).Value = "X"
End If
GoTo 1
Next
1
End Sub
 

تمت امحاولة دون جدوي ...... يرجي من اهل الخبرة المعاونة. وشكراً

ولماذا لم تستخدم دالة VLOOKUP كما استخدمتها من قبل

كما انه لم اتمكن تخطي الخطأ مع فصل كل معادلة حقل ORDER TYPE بمفرده ولكن دون جدوي بالإضافة عدم ظهور بيانات حقل Partner في كلا خيارات حقل ORDER TYPE

يرجي الانتظار حتي يتمكنوا اهل الخبرة من قراءة وتطبيق واجراء وخطوات الكود للوصول الي المغذي الحقيقي

تسلم ايديكوا وعقولكم

بارك الله فيكم وجزاكم عنا خيراً