ابو .. عبدالرحمن

أغسطس 4, 2023

مشكورين جميعاً على هذه الجهود المبذولة

واتمني ان يكتمل بقية الاوامر

بالنسبة للبحث حتى الان لم يضبط معي

أغسطس 2, 2023

9 ساعات مضت, ابا اسماعيل said:

¨

جرب الكود التالي لعله المطلوب الخاص بي ترحيل

Private Sub CommandButton1_Click()
    ' ÊÍÏíÏ ÇáÕÝÍÉ ÇáÃÕáíÉ
    Dim wsSource As Worksheet
    Set wsSource = ThisWorkbook.Sheets("الرئسية")

    ' ÊÍÏíÏ ÇáÕÝÍÉ ÇáåÏÝ
    Dim wsTarget As Worksheet
    Set wsTarget = ThisWorkbook.Sheets("البيانات")

    ' ÊÑÍíá ÇáÈíÇäÇÊ
    Dim lastRow As Long
    lastRow = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim searchRange As Range
    Set searchRange = wsTarget.Range("A2:A" & lastRow) ' äØÇÞ ÇáÈÍË Ýí ÇáÕÝÍÉ ÇáåÏÝ

    If Application.WorksheetFunction.CountIf(searchRange, wsSource.Range("C8").Value) = 0 Then
        ' äÓÎ ÑÞã ÇáãÚÇãáÉ ÅÐÇ áã íÊã ÇáÚËæÑ Úáíå Ýí ÇáÕÝÍÉ ÇáåÏÝ
        wsSource.Range("C8").Copy wsTarget.Cells(lastRow + 1, 1)
        wsSource.Range("C10").Copy wsTarget.Cells(lastRow + 1, 2)
        wsSource.Range("C12").Copy wsTarget.Cells(lastRow + 1, 3)
        wsSource.Range("C14").Copy wsTarget.Cells(lastRow + 1, 4)
        wsSource.Range("C16").Copy wsTarget.Cells(lastRow + 1, 5)
        wsSource.Range("C18").Copy wsTarget.Cells(lastRow + 1, 6)
          wsSource.Range("F8").Copy wsTarget.Cells(lastRow + 1, 7)
        wsSource.Range("F10").Copy wsTarget.Cells(lastRow + 1, 8)
        wsSource.Range("F12").Copy wsTarget.Cells(lastRow + 1, 9)
        wsSource.Range("F14").Copy wsTarget.Cells(lastRow + 1, 10)
        wsSource.Range("F16").Copy wsTarget.Cells(lastRow + 1, 11)
        wsSource.Range("F18").Copy wsTarget.Cells(lastRow + 1, 12)
        
          wsSource.Range("I8").Copy wsTarget.Cells(lastRow + 1, 7)
        wsSource.Range("I10").Copy wsTarget.Cells(lastRow + 1, 8)
        wsSource.Range("I12").Copy wsTarget.Cells(lastRow + 1, 9)
        wsSource.Range("I14").Copy wsTarget.Cells(lastRow + 1, 10)
        wsSource.Range("I16").Copy wsTarget.Cells(lastRow + 1, 11)
        wsSource.Range("I18").Copy wsTarget.Cells(lastRow + 1, 12)
        
        
    Else
        ' ÇÓÊÈÏÇá ÇáÈíÇäÇÊ ÅÐÇ Êã ÇáÚËæÑ Úáì ÑÞã ÇáãÚÇãáÉ ãæÌæÏðÇ ÈÇáÝÚá Ýí ÇáÕÝÍÉ ÇáåÏÝ
        Dim foundRow As Range
        Set foundRow = searchRange.Find(What:=wsSource.Range("C8").Value, LookIn:=xlValues, LookAt:=xlWhole)

        If Not foundRow Is Nothing Then
            wsTarget.Cells(foundRow.Row, 2).Value = wsSource.Range("C10").Value
            wsTarget.Cells(foundRow.Row, 3).Value = wsSource.Range("C12").Value
            wsTarget.Cells(foundRow.Row, 4).Value = wsSource.Range("C14").Value
            wsTarget.Cells(foundRow.Row, 5).Value = wsSource.Range("C16").Value
            wsTarget.Cells(foundRow.Row, 6).Value = wsSource.Range("C18").Value
             
             wsTarget.Cells(foundRow.Row, 7).Value = wsSource.Range("F10").Value
            wsTarget.Cells(foundRow.Row, 8).Value = wsSource.Range("F12").Value
            wsTarget.Cells(foundRow.Row, 9).Value = wsSource.Range("F14").Value
            wsTarget.Cells(foundRow.Row, 10).Value = wsSource.Range("F16").Value
            wsTarget.Cells(foundRow.Row, 11).Value = wsSource.Range("F18").Value
            
             wsTarget.Cells(foundRow.Row, 12).Value = wsSource.Range("I8").Value
             
            wsTarget.Cells(foundRow.Row, 13).Value = wsSource.Range("I10").Value
            wsTarget.Cells(foundRow.Row, 14).Value = wsSource.Range("I12").Value
            wsTarget.Cells(foundRow.Row, 15).Value = wsSource.Range("I14").Value
            wsTarget.Cells(foundRow.Row, 16).Value = wsSource.Range("I16").Value
            
        End If
    End If

End Sub

الله يعطيك العافية

حاولت اعدل فيه حاجات وارتبه من بعض الاعمدة الناقصة

حتى اصبح بهذا الشكل

Private Sub CommandButton1_Click()
' تحديد الصفحة الأصلية
Dim wsSource As Worksheet
Set wsSource = ThisWorkbook.Sheets("الرئيسية")
' تحديد الصفحة الهدف
Dim wsTarget As Worksheet
Set wsTarget = ThisWorkbook.Sheets("البيانات")
' ترحيل البيانات
Dim lastRow As Long
lastRow = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row
Dim searchRange As Range
Set searchRange = wsTarget.Range("A2:A" & lastRow) ' نطاق البحث في الصفحة الهدف
If Application.WorksheetFunction.CountIf(searchRange, wsSource.Range("C8").Value) = 0 Then
' نسخ رقم المعاملة إذا لم يتم العثور عليه في الصفحة الهدف
wsSource.Range("C8").Copy wsTarget.Cells(lastRow + 1, 1)
wsSource.Range("C10").Copy wsTarget.Cells(lastRow + 1, 2)
wsSource.Range("C12").Copy wsTarget.Cells(lastRow + 1, 3)
wsSource.Range("C14").Copy wsTarget.Cells(lastRow + 1, 4)
wsSource.Range("C16").Copy wsTarget.Cells(lastRow + 1, 5)
wsSource.Range("C18").Copy wsTarget.Cells(lastRow + 1, 6)
wsSource.Range("F8").Copy wsTarget.Cells(lastRow + 1, 7)
wsSource.Range("F10").Copy wsTarget.Cells(lastRow + 1, 8)
wsSource.Range("F12").Copy wsTarget.Cells(lastRow + 1, 9)
wsSource.Range("F14").Copy wsTarget.Cells(lastRow + 1, 10)
wsSource.Range("F16").Copy wsTarget.Cells(lastRow + 1, 11)
wsSource.Range("F18").Copy wsTarget.Cells(lastRow + 1, 12)
wsSource.Range("I8").Copy wsTarget.Cells(lastRow + 1, 13)
wsSource.Range("I10").Copy wsTarget.Cells(lastRow + 1, 14)
wsSource.Range("I12").Copy wsTarget.Cells(lastRow + 1, 15)
wsSource.Range("I14").Copy wsTarget.Cells(lastRow + 1, 16)
wsSource.Range("I16").Copy wsTarget.Cells(lastRow + 1, 17)
wsSource.Range("I18").Copy wsTarget.Cells(lastRow + 1, 18)

wsSource.Range("C8").Value = ""
wsSource.Range("C10").Value = ""
wsSource.Range("C12").Value = ""
wsSource.Range("C14").Value = ""
wsSource.Range("C16").Value = ""
wsSource.Range("C18").Value = ""
wsSource.Range("F8").Value = ""
wsSource.Range("F10").Value = ""
wsSource.Range("F12").Value = ""
wsSource.Range("F14").Value = ""
wsSource.Range("F16").Value = ""
wsSource.Range("F18").Value = ""
wsSource.Range("I8").Value = ""
wsSource.Range("I10").Value = ""
wsSource.Range("I12").Value = ""
wsSource.Range("I14").Value = ""
wsSource.Range("I16").Value = ""
wsSource.Range("I18").Value = ""
Else
' استبدال البيانات إذا تم العثور على رقم المعاملة موجودًا بالفعل في الصفحة الهدف
Dim foundRow As Range
Set foundRow = searchRange.Find(What:=wsSource.Range("C8").Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not foundRow Is Nothing Then
wsTarget.Cells(foundRow.Row, 1).Value = wsSource.Range("C8").Value
wsTarget.Cells(foundRow.Row, 2).Value = wsSource.Range("C10").Value
wsTarget.Cells(foundRow.Row, 3).Value = wsSource.Range("C12").Value
wsTarget.Cells(foundRow.Row, 4).Value = wsSource.Range("C14").Value
wsTarget.Cells(foundRow.Row, 5).Value = wsSource.Range("C16").Value
wsTarget.Cells(foundRow.Row, 6).Value = wsSource.Range("C18").Value
wsTarget.Cells(foundRow.Row, 7).Value = wsSource.Range("F8").Value
wsTarget.Cells(foundRow.Row, 8).Value = wsSource.Range("F10").Value
wsTarget.Cells(foundRow.Row, 9).Value = wsSource.Range("F12").Value
wsTarget.Cells(foundRow.Row, 10).Value = wsSource.Range("F14").Value
wsTarget.Cells(foundRow.Row, 11).Value = wsSource.Range("F16").Value
wsTarget.Cells(foundRow.Row, 12).Value = wsSource.Range("F18").Value
wsTarget.Cells(foundRow.Row, 13).Value = wsSource.Range("I8").Value
wsTarget.Cells(foundRow.Row, 14).Value = wsSource.Range("I10").Value
wsTarget.Cells(foundRow.Row, 15).Value = wsSource.Range("I12").Value
wsTarget.Cells(foundRow.Row, 16).Value = wsSource.Range("I14").Value
wsTarget.Cells(foundRow.Row, 17).Value = wsSource.Range("I16").Value
wsTarget.Cells(foundRow.Row, 18).Value = wsSource.Range("I18").Value  
        End If
    End If
End Sub

ولكن باقي البحث والتعديل والحذف

ملاحظة

بعد الترحيل ما يمسح رغم اني عملت له اومر لمسح الخلايا بعد الترحيل لكن مازال فيه اشكالية

اتمنى مواصلة العمل حتى يكتمل ولكم جزيل الشكر

يوليو 30, 2023

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

اخواني الكرام

رفق لكم برنامج قمت بتصميمه على شكل صفحة رئيسية لإدخال البيانات وصفحة البيانات المدخلة

ولكن لم استطع الوصول الى اكواد اتمكن من اكمال هذا البرنامج

اتمنى من الخبراء اكمال الاكواد المطلوبة وهي : ( كود الترحيل (ادخال البيانات) ، كود التعديل ، كود البحث وقائمة البحث ، كود الطباعة لشيت البيانات ، كود الحذف )

بحيث يعمل البرنامج بالشكل الصحيح .... ولكم تحياتي وشكري

برنامج المعاملات المالية.xlsm

يوليو 10, 2023

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

رغم اني كنت اتوقع اني لم احتاج الى تغيير الفورم

ولكن اشكرك على الاستجابة والمساعدة وتحياتي لك

يوليو 10, 2023

بحث في الفورم.xlsb

هذا ملف ارفقته ووضحت فيه المطلوب باختصار

اتمنى اجد من يساعدنى ولكم جزيل الشكر

يوليو 9, 2023

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

اخواني الكرام اريد مساعدة في تعديل هذا الامر

Private Sub CommandButton1_Click()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
  For Each f In ws.Range("a2:a1000")
  If f = TextBox1.Text Then
  ws.Select
  f.Select
  Exit For
  End If
  Next f
  Next ws
  ActiveCell.Value = TextBox1.Value
  ActiveCell.Offset(0, 1).Value = TextBox2.Value
    ActiveCell.Offset(0, 2).Value = TextBox3.Value
     ActiveCell.Offset(0, 3).Value = TextBox4.Value
      ActiveCell.Offset(0, 4).Value = TextBox5.Value
       ActiveCell.Offset(0, 5).Value = TextBox6.Value
       MsgBox "تم تعديل البيانات بنجاح"
  
  TextBox1.Value = ""
     TextBox2.Value = ""
   TextBox3.Value = ""
   TextBox4.Value = ""
   TextBox5.Value = ""
   TextBox6.Value = ""
   TextBox8.Value = ""  
End Sub

Private Sub TextBox8_Change()

'    TextBox1.Value = ""
'    TextBox2.Value = ""
'    TextBox3.Value = ""
'    TextBox4.Value = ""
'    TextBox5.Value = ""
'    TextBox6.Value = ""
'    TextBox7.Value = ""
'
If TextBox8.Value = "" Then ListBox1.Clear: Exit Sub
Dim x As Worksheet

         ListBox1.Clear
    k = 0
For Each x In ThisWorkbook.Worksheets
        ss = x.Cells(Rows.Count, 1).End(xlUp).Row
        For Each c In x.Range("a2:a" & ss)
            b = InStr(c, TextBox8)
            If b > 0 Then
                ListBox1.AddItem
                ListBox1.List(k, 0) = x.Cells(c.Row, 1).Value
                ListBox1.List(k, 1) = x.Cells(c.Row, 2).Value
                ListBox1.List(k, 2) = x.Cells(c.Row, 3).Value
                ListBox1.List(k, 3) = x.Cells(c.Row, 4).Value
                ListBox1.List(k, 4) = x.Cells(c.Row, 5).Value
                ListBox1.List(k, 5) = x.Cells(c.Row, 6).Value
'                ListBox1.List(k, 6) = x.Cells(c.Row, 7).Value
                k = k + 1
            End If
        Next c

Next x
End Sub

اريد يبحث في شيت واحد فقط

ويكون البحث في نطاق الخلية a1 الى الخلية k1

بحيث يتم استخراج كلمة البحث من الخلية h5 h6 h7 ............. الى اخر الجدول

ولكم جزيل الشكر

يونيو 3, 2023

اخي اشرف اشكرك على الاستجابة وجزاك الله خير

يونيو 1, 2023

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

اخواني الكرام وخبراء الاكسيل المحترمين

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

أبريل 30, 2023

اتوقع بان عدم ظهور الفيرم بعد 10 ثواني ان معادلة الساعة التي يستمر نبضها خلال الوقت هي التي تجعل الشيت او البرنامج في حالة مستمر غير ساكنه

لذلك اتوقع انها السبب والله اعلم

أبريل 30, 2023

مشكور الله يعطيك العافية بذلت جهد كبير

رغم انه لم يتم تفعيل الوقت الا اذا كنت على نفس الفيرم واضغط على زر تشغيل

ولكن اشكرك على تعاونك معي وجزاك الله خير

أبريل 30, 2023

ممتاز حبيبي الله يعطيك العافية هذا المطلوب بارك الله فيك

بقي حاجة واحدة فقط وهي تفعيل 10 ثواني او 30 ثانية في حالة السكون . وتظهر شاشة الفيرم تلقائي

اذا كان ذلك ممكن

أبريل 30, 2023

تمام بيض الله وجهك بجرب وان شاء الله تضبط معي

واعذرني على الاطالة

أبريل 30, 2023

الله يعطيك العافية

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

وكذلك خاصية زر الاغلاق من الاكس مازالت تعمل

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

أبريل 30, 2023

23 ساعات مضت, كريم نظيم said:

مشكور اخي كريم ولكن يظهر الغلط في هذه الجملة 
UserForm1.Show
نهاية السطر الاخير مدري ويش المشكلة
وبعدين مايفتح بعد 10 ثواني 
وكذلك اذا ضغط زر الشاشة لفتح فيرم اسم المستخدم يبقي اسم المستخدم وكلمة المرور ظاهرة

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

أبريل 29, 2023

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

مازلت بالا نتظار

أبريل 18, 2023

اخواني الكرام جزاكم الله خير ولكن المطلوب يمكن اني ما وضحته لكم بالشكل الصحيح

ولكن الان برفق لكم الملف نفسه والطلب في الصفحة الرئيسية وشكرا

اريد هذا يكون زر ويكون له مدلول بشرطين :

01 في حالة سكون البرنامج دقيقة يفح شاشة الدخول تلقائي ولكن مع مسح اسم المستخدم وكلمة المرور .

02 في حالة الضغط على هذا الزر يفخ شاشة الدخول مع مسح اسم المستخدم وكلمة المرور

Screenshot___Microsoft365(Office).jpg.97041592092c7c2e90f502029070e065.jpg

https://www.raed.net/file?id=205646

أبريل 15, 2023

بسم الله الرحمن الرحيم

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

اريد ان اعمل زر يكون داخل الشيت بحيث اذا بغيت اوقف البرنامج يظهر لي user form1

مع اخفاء الشيت ولا يمكن الدخول للشيت الا بعد ادخال اسم المستخدم وكلمة المرور

اسم المستخدم m

كلمة المرور 1234

المحاسبة والإدارة المالية.xlsb

تسجيل الدخول

ابو .. عبدالرحمن

Posts

تاريخ الانضمام

تاريخ اخر زياره

Days Won

نوع المحتوي

المنتدى

مكتبة الموقع

معرض الصور

المدونات

الوسائط المتعددة

مشاركات المكتوبه بواسطه ابو .. عبدالرحمن

اضافة اكواد لبرنامج

اضافة اكواد لبرنامج

اضافة اكواد لبرنامج

بحث في الفورم

بحث في الفورم

بحث في الفورم

معادلة لمسح المعلومات من الفورم

معادلة لمسح المعلومات من الفورم

زر في الشيت

زر في الشيت

زر في الشيت

زر في الشيت

زر في الشيت

زر في الشيت

زر في الشيت

زر في الشيت

زر في الشيت

تصفح الموقع

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

Support

Important Information