Jump to content
أوفيسنا

حسين مامون

Expert
  • Content Count

    851
  • Joined

  • Last visited

Community Reputation

374 Excellent

About حسين مامون

  • Rank
    Name

Profile Information

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

Contact Methods

  • MSN
    assotintaleb22@hotmail.com

Recent Profile Visitors

1,697 profile views
  1. بوركت اخي و الحمد لله ان تم الامر على خير
  2. استاد حسن البدوي لا اعرق لماذا تعيد نفس طلب مشاركة سابقة علما انني اجبتك في تلك المشاركة ولم تبدي اي رأي ، كان بالامكان طلب تعديل نفس المشاركة وتجنب اهدار وقتك و وقت الاعضاء عموما اليك المرفق اولا ادخل اسم العميل ثم البيانات الاخرى ثانيا اضغط زر حفظ ملاحظة : لا يمكن تكرار نفس العميل اكثر من مرة تحياتي الفاتورة الرئيسيه (3).xlsm
  3. جرب المرفق Sub serchsheet() Dim sh As Worksheet Dim rng As Range Set rng = Sheets("ÊÚÏíá_ÓÚÑ_ÇáÚãíá").Range("G2") Application.ScreenUpdating = False For Each sh In ThisWorkbook.Worksheets If sh.Name = rng.Text Then sh.Visible = True sh.Activate Exit For End If Next sh Application.ScreenUpdating = True End Sub الفاتورة الرئيسية.xlsm
  4. جرب هذا الماكرو لعله يفي بالغرض Sub TRANS() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim lr1, lr2 Set ws1 = Sheets("جدول المبيعات") Set ws2 = Sheets("قائمة المبيعات") lr1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row lr2 = ws2.Cells(Rows.Count, 2).End(xlUp).Row + 1 ws1.Range("b6:b" & lr1).Copy ws2.Range("b" & lr2) ws1.Range("c6:c" & lr1).Copy ws2.Range("e" & lr2) End Sub ترحيل.xlsm
  5. جرب المرفق الفاتورة الرئيسيه (3).xlsm
  6. السلام عليكم ربما يكون ما تريد في اضافة هذا السطر للكود بعد الحلقة التكرارية If FS.Range("b6").Text = TS.Cells(er2, 1).Text Then MsgBox "هذا الاسم مكرر": Exit Sub
  7. وعليكم السلام ورحمة الله الاخ محمد عبد السلام ما المقصود بانشاء شيت2 وترحيل نفس البيانات لي في شيت1 هل ممكن توضيح ؟ اضافة اشياء اخرى للكود لا نحتاجها قد يثقل عمل الكود اضف هذه السطور اسفل الجزء الذي يرحل الى شيت1 Dim wss2 As Worksheet Set wss2 = wx.Sheets("sheet2") Dim lr2 lr2 = wss2.Range("a" & Rows.Count).End(xlUp).row + 1 If ws.[f5].Text = "اجل" Then wss2.Range("a" & lr2).Value = Nam wss2.Range("a" & lr2).Font.Color = 255 wss2.Range("b" & lr2).Value = "اجل"
  8. جرب المرفق لعله يفي بالغرض المصنف1( (1).xlsm
  9. عليكم السلام ورحمة الله اخي الكريم اليك هذا العمل حسب ما فهمت في مشاركتك Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim LR As Long Dim rng Dim tot Set tot = Range("b10") Set rng = Range("b2:b9") If Not Intersect(Target, rng) Is Nothing Then Range("b10").Formula = "=SUM(B2:B9)" If Range("b10") > 100 Then MsgBox "خطأ في الادخال" Target = "" Target.Activate End If End If End Sub test.xlsm
  10. عليكم السلام جرب هذا التعديل ولكن مذا عن استعراص البيانات في الفورم ؟ سيأتر هذا عن ذلك وستضطر لتعديل الفورم Private Sub CommandButton1_Click() Dim ws As Worksheet Set ws = ActiveWorkbook.Sheets("invoice") Dim wss As Worksheet Set wss = ActiveWorkbook.Sheets("Sheet1") Dim DT Dim Nam Dim lr As Long Application.ScreenUpdating = False Application.EnableEvents = False lr = wss.Range("a" & Rows.Count).End(xlUp).Row + 1 DT = ws.Range("e5") & Format(Now(), " ss - mm - hh - yyyy - mm - dd ") With ws Application.Di
  11. السلام عليكم سبب مشكلتك اظن هذا الكود فعندما تنتقل الى شيت "ملاك" ينشط الكود ويلغي عملية اللصق Private Sub Worksheet_Activate() ScreenOn End Sub Sub ScreenOn() Application.Calculation = xlAutomatic Application.EnableEvents = True Application.ScreenUpdating = True End Sub
  12. السلام عليكم بعد اذن الاستاذ جرب تغيير بسيط في الكود اضف "Value" الى textbox1 و textbox2 .Range("A" & lastRow).Value = TextBox1.Value .Range("B" & lastRow).Value = TextBox2.Value مثال.xlsm
  13. نسال الله لها الرحمة والمغفرة والفردوس الاعلى من الجنة و لا حول و لا قوة الا بالله انا لله وانا اليه راجعون
×
×
  • Create New...