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

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


إذهب إلى أفضل إجابة Solved by محمد هشام.,

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

السلام عليكم

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

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

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

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

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

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

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

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

رابط هذا التعليق
شارك

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

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

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

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

 

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

Screenshot_2023-02-12-10-05-10-00_99c04817c0de5652397fc8b56c3b3817.jpg

تم تعديل بواسطه محمود الطحاوي
رابط هذا التعليق
شارك

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

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

 

 

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

  • Like 1
  • Thanks 1
رابط هذا التعليق
شارك

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

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

 

 

 

رابط هذا التعليق
شارك

On 2/13/2023 at 3:51 PM, محمود الطحاوي 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

تم تعديل بواسطه Mohamed Hicham
  • Like 1
رابط هذا التعليق
شارك

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

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information