اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

يرجى تعديل زر الحذف والتعديل في اليوزرفورم


Alaaq3
إذهب إلى أفضل إجابة Solved by حسين مامون,

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

السلام عليكم ورحمة الله وبركاته وكل عام وانتم بألف خير / اخواني الاعزاء هذا (اليوزر فورم) المرفق من برمجة الاخت الفاضلة ساجدة العزاوي وتم تعديله من قبل الاخ (العيدروس) ليصبح يبحث في كل الشيتات .

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

يرجى تعديل كود الحذف والتعديل.xlsm

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

هذا هو الكود كما ارسلته سابقا

ولكن يجب اضافة ليبل للفورم وسميه "Label33"

Private Sub CommandButton1_Click()
Dim lr, i, j
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(3).Row
For i = 2 To lr
    If Label33.Caption = Cells(i, 1).Row Then
        For j = 1 To 26
        
       Cells(i, j) = Controls("TextBox" & j).Text
        Next j
        Exit For
    End If
Next i
Application.ScreenUpdating = False

End Sub

 

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

 Dim r As Integer

Private Sub CommandButton1_Click()
Dim lr, i, j
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(3).Row
For i = 2 To lr
    If Label33.Caption = Cells(i, 1).Row Then
        For j = 1 To 26
        
       Cells(i, j) = Controls("TextBox" & j).Text
        Next j
        Exit For
    End If
Next i
Application.ScreenUpdating = False

End Sub

Private Sub CommandButton3_Click()
If TextBox7.Value = "" Then
MsgBox "áÇÊæÌÏ ÈíÇäÇÊ ááÍÐÝ", vbCritical, "ÊäÈíå"
Exit Sub
End If
If MsgBox("ÓíÊã ÇáÍÐÝ åá ãÊÃßÏ¿", vbQuestion + vbYesNo) = vbYes Then
  lro = Sheets(ComboBox1.Value).Cells(Rows.Count, 7).End(xlUp).Row
   Set m = Sheets(1).Range("A" & r & ":A" & lro)
   For Each cell In m
   cell.Value = cell.Value - 1
   Next
   
   
  Sheets(ComboBox1.Value).Cells(r, 1).Resize(, 55).Delete shift:=xlUp
       MsgBox "ÊãÊ ÚãáíÉ ÇáÍÐÝ ÈäÌÇÍ"
   For y = 1 To 55
   Controls("textbox" & y).Text = ""
   Next y
   ListBox1.Clear
   UserForm_Activate
   TextBox100 = ""
   End If
   
   TextBox1.Value = Application.WorksheetFunction.Max(Sheets(ComboBox2.Value).Range("A2:A10000")) + 1
TextBox2.SetFocus
End Sub

Private Sub CommandButton4_Click()
TextBox100.Value = ""
ListBox1.Clear
End Sub

Private Sub ListBox1_Click()

For i = 0 To ListBox1.ListCount
    If ListBox1.Selected(i) = True Then
        For j = 1 To 26
        Controls("TextBox" & j).Text = Sheets(ListBox1.List(i, 1)).Cells(ListBox1.List(i, 2), j)
        Label33.Caption = Sheets(ListBox1.List(i, 1)).Cells(ListBox1.List(i, 2), j).Row
        Next j
        r = ListBox1.List(i, 2)
        
        Exit For
    End If
Next i
End Sub


Private Sub TextBox1_Change()

End Sub

Private Sub TextBox2_Change()

End Sub

Private Sub TextBox27_Change()

If TextBox27.Value <> "" Then
ListBox1.Visible = True
Else
ListBox1.Visible = False
End If

Dim x As Worksheet
Dim c As Range
ListBox1.Clear
k = 0
    For i = 1 To 26
            Controls("TextBox" & i).Text = ""
    Next i

    If TextBox27 = "" Then Exit Sub
   
    
  
 For Each x In ThisWorkbook.Worksheets
SS = x.Cells(Rows.Count, 2).End(xlUp).Row
For Each c In x.Range("B2:B" & SS)
b = InStr(c, TextBox27)
If Trim(c) Like "*" & TextBox27 & "*" Then
ListBox1.AddItem
ListBox1.List(k, 0) = x.Cells(c.Row, 2)
ListBox1.List(k, 1) = c.Worksheet.Name
ListBox1.List(k, 2) = c.Row
k = k + 1
End If
Next c
Next x
End Sub

Private Sub TextBox5_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox27.Value = ""
ListBox1.Clear
End Sub

 

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

الكود يعمل فقط على الشيت النشط 

يمكنك تعديله باضافة with activesheet في بداية الكود  و end with t في اخره مع اصافة نقطة لبداية السطور لي تبدأ ب cells

Dim lr, i, j
With ActiveSheet
Application.ScreenUpdating = False
lr = .Cells(Rows.Count, 1).End(3).Row
For i = 2 To lr
    If Label33.Caption = .Cells(i, 1).Row Then
        For j = 1 To 26
        
       .Cells(i, j) = Controls("TextBox" & j).Text
        Next j
        Exit For
    End If
Next i
Application.ScreenUpdating = False
End With

 

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

لا . وانما اقصد يقوم بالتعديل على البيانات بغض النظر عن كون الشيت اكتف او غير اكتف . مثلا اريد التعديل على اسم معين في احد الشيتات يقوم بالتعديل حتى لو كان الشيت الذي يحتوي على الاسم غير اكتف 

 

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

اخي العزيز اسف يبدو انك لم تعرف ماذا اريد؟ . اخي الكريم انا اريد ان يغير الاسم الذي اريده في شيت معين وليس تغيير اكثر من اسم في شيتات اخرى

اخي العزيز : اسف ع الإطالة ولكن الكود يقوم بتغيير الاسماء المتشابة  في الشيت الآخر وهذا لا اريده (  انا اريد ان يقوم بتغيير اسم واحد فقط )

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

 لا يمكن التعديل بدون شرط  والا كيف يمكن للكود ان يجد البيان  المختار ضمن مئات البيانات؟

عموما  الشرط  هنا هو رقم الرو  

اختر شيت في الكومبوبوكس ثم عدل ما تريد واضغط زر العديل

 

يرجى تعديل كود الحذف والتعديل (1).xlsm

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

احسنت اخي العزيز بارك الله فيك . ممتن لك , الآن الكود يعمل بصورة صحيحة . شكراً جزيلاً لك . وياريت تكمل فضلك وتعدل كود الحذف مع الحفاظ على التسلسل 

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

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