طلب تصحيح اكواد ازرار يوزرفورم

محمود الطحاوي · فبراير 5, 2023

السلام عليكم

الملف المرفق من تصميم اخ فاضل من المنتدي، ولمتطلبات العمل قمت بالتعديل حسب قدراتي منعا لطلب المزيد من التعديلات من الاخ لعدم اجهاده ، لكن اريد تصحيح كود زر البحث بالاسم لياخد من العمودB

(بالحروف العربية والإنجليزية)

Aوالبحث بالرقم ليعتمد على العمود

وزر الطباعة ليقوم بطباعة المعلومات التي تكون ظاهرة على الشاشة كما هي في اليوزرفورم

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

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

باسوورد التعديل على الفورم a010b010

متابعة النشاط 2023 تجربة تعديل.xlsm

محمود الطحاوي · فبراير 11, 2023

اولا .. شكراً على وقتك ومساعدتك

ثانيا : بالنسبة للفورم انا كنت عمل مقاس الفورم حسب مقاس الشاشة لكن حاليا ليس امامي نفس الجهاز للأسف فالفورم ليس ظاهر بالكامل لكن المقصود هما المستطيلين أعلى يمين الفورم .. احدهما للبحث بالاسم ويكون بالحروف العربية والانجليزية يأخذ بياناته من العمود المكتوب عليه ( الجهة) في الشيت، والآخر بالارقام العربية والانجليزية والحروف العربية ويأحذ البيانات من العمود المكتوب عليه ( الرقم) في الشيت

أرجو أن أكون أجبت عن السؤال

وشكرا مرة ثانية

هذا هو المقصود list box 1 &2

تم تعديل فبراير 11, 2023 بواسطه محمود الطحاوي

**محمد هشام.** · فبراير 12, 2023

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

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

طلب وتعديل يوزيرفورم 4.xlsm

محمود الطحاوي · فبراير 12, 2023

جزاك الله خيراً .. جاري التجربة

الف شكر لحضرتك

سأجرب ما وضعه الأخ هشام وأعود إليكم بالرد إن شاء الله

محمود الطحاوي · فبراير 13, 2023

مشكور بارك الله فيك

فقط ارجو معرفة كود لتكبير الصورة بالنقر عليها بالماوس، وكود لطباعة محتويات الفورم بدون ازرار لان زر الطباعة يطبع كامل ورقة العمل نفسها بالكامل

محمود الطحاوي · فبراير 14, 2023

On 2/13/2023 at 3:51 PM, محمود الطحاوي said:

مشكور بارك الله فيك

فقط ارجو معرفة كود لتكبير الصورة بالنقر عليها بالماوس، وكود لطباعة محتويات الفورم بدون ازرار لان زر الطباعة يطبع كامل ورقة العمل نفسها بالكامل

او اضافة الاكواد للفورم

محمود الطحاوي · فبراير 20, 2023

الأخ @Mohamed Hicham

شكرا لمجهودك

الضغط على زر التعديل يعطيني هذا الخطأ ، مع العلم اني لم اقم بأي شئ في التكواد

**محمد هشام.** · فبراير 20, 2023

تفضل اخي تم تعديل كود الترحيل والتعديل معا ليتناسب مع الاضافات الجديدة

Private Sub Modify_data_Click()  'تعديل
Set WS = Sheet1
If TextBox1.Text = "" Then
MsgBox "برجاء ادخال الرقم"
Exit Sub
Else
        Dim x As Long
        Dim y As Long
        x = WS.Range("A" & Rows.Count).End(xlUp).Row
        For y = 2 To x
            If WS.Cells(y, 1).Value = Me.recherch.Text Or WS.Cells(y, 2).Value = Me.recherch2.Text Then
               WS.Cells(y, 1).Value = Me.TextBox1.Value
               WS.Cells(y, 2).Value = Me.TextBox2.Value
               WS.Cells(y, 3).Value = Me.TextBox3.Value
               WS.Cells(y, 4).Value = Me.TextBox4.Value
               WS.Cells(y, 5).Value = Me.TextBox5.Value
               WS.Cells(y, 6).Value = Me.TextBox6.Value
               WS.Cells(y, 9).Value = Me.TextBox7.Value
               WS.Cells(y, 10).Value = Me.TextBox8.Value
               WS.Cells(y, 11).Value = Me.TextBox9.Value
               WS.Cells(y, 21).Value = Me.Label11.Caption
            End If
        Next y
        
For Each ctrl In Me.Controls
        If TypeName(ctrl) = "TextBox" Then
            ctrl.Value = ""
        End If
    Next ctrl
Me.recherch.Value = ""
Me.Label11.Caption = ""
Me.Image1.Picture = LoadPicture(Label11.Caption)
Me.ListBox1.Visible = False
End If
MsgBox "تم تعديل البيانات", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "تأكيد"
End Sub

Private Sub Data_transfer_Click()  'ترحيل
Dim sh As Worksheet
Dim lr As Long
Set sh = Sheet1 'ThisWorkbook.Sheets("نشاط")
lr = sh.Range("A" & Rows.Count).End(xlUp).Row
If UserForm4.TextBox1.Text = "" Then
MsgBox "برجاء ادخال البيانات"
Exit Sub
End If

       With sh
            .Cells(lr + 1, "A").Value = Me.TextBox1.Text
            .Cells(lr + 1, "B").Value = Me.TextBox2.Text
            .Cells(lr + 1, "C").Value = Me.TextBox3.Text
            .Cells(lr + 1, "D").Value = Me.TextBox4.Text
            .Cells(lr + 1, "E").Value = Me.TextBox5.Text
            .Cells(lr + 1, "F").Value = Me.TextBox6.Text
            .Cells(lr + 1, "I").Value = Me.TextBox7.Text
            .Cells(lr + 1, "J").Value = Me.TextBox8.Text
            .Cells(lr + 1, "K").Value = Me.TextBox9.Text
            .Cells(lr + 1, "U").Value = UserForm4.Label11.Caption
       End With
For Each ctrl In Me.Controls
        If TypeName(ctrl) = "TextBox" Then
            ctrl.Value = ""
        End If
    Next ctrl
Me.recherch = Empty
Me.Label11.Caption = Empty
Me.Image1.Picture = LoadPicture(Label11.Caption)
MsgBox "تم ترحيل البيانات بنجاح ", Exclamation, "محمود الطحاوي"
End Sub

طلب تعديل يوزيرفورم 5.xlsm

تم تعديل فبراير 20, 2023 بواسطه Mohamed Hicham

محمود الطحاوي · فبراير 23, 2023

On 2/20/2023 at 7:06 PM, Mohamed Hicham said:

تفضل اخي تم تعديل كود الترحيل والتعديل معا ليتناسب مع الاضافات الجديدة

Private Sub Modify_data_Click()  'تعديل
Set WS = Sheet1
If TextBox1.Text = "" Then
MsgBox "برجاء ادخال الرقم"
Exit Sub
Else
        Dim x As Long
        Dim y As Long
        x = WS.Range("A" & Rows.Count).End(xlUp).Row
        For y = 2 To x
            If WS.Cells(y, 1).Value = Me.recherch.Text Or WS.Cells(y, 2).Value = Me.recherch2.Text Then
               WS.Cells(y, 1).Value = Me.TextBox1.Value
               WS.Cells(y, 2).Value = Me.TextBox2.Value
               WS.Cells(y, 3).Value = Me.TextBox3.Value
               WS.Cells(y, 4).Value = Me.TextBox4.Value
               WS.Cells(y, 5).Value = Me.TextBox5.Value
               WS.Cells(y, 6).Value = Me.TextBox6.Value
               WS.Cells(y, 9).Value = Me.TextBox7.Value
               WS.Cells(y, 10).Value = Me.TextBox8.Value
               WS.Cells(y, 11).Value = Me.TextBox9.Value
               WS.Cells(y, 21).Value = Me.Label11.Caption
            End If
        Next y
        
For Each ctrl In Me.Controls
        If TypeName(ctrl) = "TextBox" Then
            ctrl.Value = ""
        End If
    Next ctrl
Me.recherch.Value = ""
Me.Label11.Caption = ""
Me.Image1.Picture = LoadPicture(Label11.Caption)
Me.ListBox1.Visible = False
End If
MsgBox "تم تعديل البيانات", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "تأكيد"
End Sub

Private Sub Data_transfer_Click()  'ترحيل
Dim sh As Worksheet
Dim lr As Long
Set sh = Sheet1 'ThisWorkbook.Sheets("نشاط")
lr = sh.Range("A" & Rows.Count).End(xlUp).Row
If UserForm4.TextBox1.Text = "" Then
MsgBox "برجاء ادخال البيانات"
Exit Sub
End If

       With sh
            .Cells(lr + 1, "A").Value = Me.TextBox1.Text
            .Cells(lr + 1, "B").Value = Me.TextBox2.Text
            .Cells(lr + 1, "C").Value = Me.TextBox3.Text
            .Cells(lr + 1, "D").Value = Me.TextBox4.Text
            .Cells(lr + 1, "E").Value = Me.TextBox5.Text
            .Cells(lr + 1, "F").Value = Me.TextBox6.Text
            .Cells(lr + 1, "I").Value = Me.TextBox7.Text
            .Cells(lr + 1, "J").Value = Me.TextBox8.Text
            .Cells(lr + 1, "K").Value = Me.TextBox9.Text
            .Cells(lr + 1, "U").Value = UserForm4.Label11.Caption
       End With
For Each ctrl In Me.Controls
        If TypeName(ctrl) = "TextBox" Then
            ctrl.Value = ""
        End If
    Next ctrl
Me.recherch = Empty
Me.Label11.Caption = Empty
Me.Image1.Picture = LoadPicture(Label11.Caption)
MsgBox "تم ترحيل البيانات بنجاح ", Exclamation, "محمود الطحاوي"
End Sub

طلب تعديل يوزيرفورم 5.xlsm 67.83 kB · 4 downloads

تمام .. شكرا جزيلا

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

تسجيل الدخول

طلب تصحيح اكواد ازرار يوزرفورم

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

محمود الطحاوي

محمود الطحاوي

محمد هشام.

محمود الطحاوي

محمود الطحاوي

محمود الطحاوي

محمود الطحاوي

محمد هشام.

محمود الطحاوي

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information