Jump to content
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

حسين مامون

Expert
  • Content Count

    957
  • Joined

  • Last visited

Community Reputation

481 Excellent

About حسين مامون

  • Rank
    Name

Profile Information

  • Gender (Ar)
    ذكر
  • Job Title
    حسين مامون
  • Interests
    اكسيل

Contact Methods

  • MSN
    assotintaleb22@hotmail.com

Recent Profile Visitors

1,882 profile views
  1. ويمكنك استخدام الكود في حدث الشيت Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Not Intersect(Target, Range("a2:l2")) Is Nothing Then If Not IsNumeric(Target.Value) And Target.Value <> vbNullString Then Target.Interior.Color = xlNone GoTo 1 End If '================= If Target >= 100 Then Target.Interior.Color = 255 End If '================== If Target < 100 Then Target.Interior.Color = 5296274 End If End If 1: End Sub
  2. بعد ادنكم ربما تقصد هذا الشيء Classeur1.xlsx
  3. بعد ادن استادي واتراء للموضوع هذه طريقة متواضعة التنفيذ بالفورم تاريخ التقاعد.xlsm
  4. ارفع صورة الخطأ او جرب الماكرو هكذا Sub Test1() Application.ScreenUpdating = False ActiveSheet.Unprotect Columns("A:E").Select Selection.EntireColumn.Hidden = False Columns("AD:AF").Select Selection.EntireColumn.Hidden = True Columns("P:AB").Select Selection.EntireColumn.Hidden = False Columns("AJ:AR").Select Selection.EntireColumn.Hidden = True Range("A10:A12").Select Application.ScreenUpdating = True ActiveSheet.Protect end sub
  5. استاذ ان شاء الله تبدأ ادخال اكواد الترحيل بنفسك نبدأ بزر ترحيل شهادة تربص ما رأيك؟ لنفترض ليك شيت "شهادة تربص" الخلية D15 هي رقم التسجيل و في الفورم textbox1 iهو رقم التسجيل ونقول في حدث الزر 'شهادة تربص" Private Sub CommandButton4_Click() With Sheets("شهادة تربص") .Range("d15").Value = TextBox1.Value ' رقم التسجيل .Range("b16").Value = TextBox2.Value 'الاسم .Range("d16").Value = TextBox3.Value 'اللقب End With End Sub ونتمم ربط باقي الخلايا ب textbox المناسب
  6. ربما يمكن الاستفادة من هذه المشاركة
  7. استعن بهذا الفيديو .... وهذا هو ملفك وعليك أيضاً أولا تحميل نوع الخط المرفوع مع ملفك ccode39.zip باركود 2022.xlsx
  8. وهذا الشيء لوكانت البيانات اقل من 10 Private Sub UserForm_Initialize() Dim lr1, lr Dim lr2 Dim i, k ListBox1.ColumnCount = 3 lr = Cells(Rows.Count, 2).End(3).Row If lr < 9 Then MsgBox "البيانات اقل من10": Exit Sub lr1 = Cells(Rows.Count, 2).End(3).Row - 10 lr2 = Cells(Rows.Count, 2).End(3).Row k = 0 For i = lr1 To lr2 ListBox1.AddItem ListBox1.List(k, 0) = Cells(i, 1).Value ListBox1.List(k, 1) = Cells(i, 2).Value ListBox1.List(k, 2) = Cells(i, 3).Value k = k + 1 Next i End Sub
  9. ضع هذا الشيء في حدث الفورم Private Sub UserForm_Initialize() Dim lr1 Dim lr2 Dim i, k ListBox1.ColumnCount = 3 lr1 = Cells(Rows.Count, 2).End(3).Row - 10 lr2 = Cells(Rows.Count, 2).End(3).Row k = 0 For i = lr1 To lr2 ListBox1.AddItem ListBox1.List(k, 0) = Cells(i, 1).Value ListBox1.List(k, 1) = Cells(i, 2).Value ListBox1.List(k, 2) = Cells(i, 3).Value k = k + 1 Next i End Sub
  10. ضع هذا الشيء في حدث تيكستبوكس1 change cheets("DATA").range("d3").value= textbox1.value وهذا ان كان ما دكرته صحيح
  11. اخي الكريم كان عليك طلب هذا منذ المشاركة الاولى عليك بطلب جديد في مشاركة جديدة ولكن حاول اختصار طلبك في فورم نظيف بدون مشاكل. تحياتي
  12. بعد ادن الاساتدة ربما هذا الشيء يفي بالغرض PRT.xlsm
  13. اضف هذا السطر في الكود كما في الصورة ws2.Range("a6:d1000").Interior.Color = xlNone الصورة
  14. بانسبة للطباعة انسخ هذا الكود الى مديول واربطه مع زر جديد في شيت الطباعة Option Explicit Sub printDOC() Dim LR LR = Cells(Rows.Count, 2).End(3).Row If MsgBox("هل تريد طباعة التقرير", vbExclamation + vbYesNo) = vbYes Then Range("a1:d" & LR).PrintPreview End If End Sub
  15. Option Explicit Sub test() Dim lr, c, x, r, lr2 Dim ws As Worksheet Set ws = Sheets("DATA") Dim ws2 As Worksheet Set ws2 = Sheets("الطباعة") c = ws.[d3] r = 6 Application.ScreenUpdating = False With ws ws2.Range("a6:d1000").ClearContents ws2.Range("a6:d1000").Borders.LineStyle = 0 lr = .Cells(Rows.Count, 1).End(3).Row For x = 6 To lr Select Case .Cells(x, 1).Value2: Case c ws2.Range("b4").Value = .Cells(x, 1).Value ws2.Range("a" & r).Value = .Cells(x, "e").Value ws2.Range("a" & r).Offset(, 1).Value = .Cells(x, "d").Value ws2.Range("a" & r).Offset(, 2).Value = .Cells(x, "b").Valu
×
×
  • Create New...