أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
هانى على لا تميز خلال هذه الفترة-- لا تميز خلال هذه الفترة YasserKhalil الترقيم بشرط معين اكسيل اسئله واجابات


أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





تنسيق مبالغ العملات المحلية والأجنبية في شيت الأكسيل بعد الترحيل

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


موضوع مغلق


14-10-2021 12:30 صباحا
ashraf_hertlion
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 18-09-2017
رقم العضوية : 540
المشاركات : 260
الجنس : ذكر
تاريخ الميلاد : 7-11-1971
يتابعهم : 14
يتابعونه : 1
قوة السمعة : 329
 offline 

السلام عليكم اساتذتى الكرام كل عام وانتم بخير بمناسبة المولد النبوى الشريف
ارجو من حضراتكم مساعدتى في تنسيق مبالغ العملات المحلية والأجنبية عند ترحيل كل صنف المطلوب تنسيق مبلغى (
قيمة الصنف لنفس العملة و إجمالى القيمة لنفس العملة ) لنفس الصنف المرحل من اليوزرفورم الى شيت Data  المرحل اليه بيانات الأصناف  .
مثال على النتيجة المتوقعه  هى التنسيق لكل صنف على حدى
وعند تغيير نوع العملة يتم تغيير تنسيق العملة حسب النوع
بيان بأكواد الأصناف
كود الصنف الاسم نوع العملة قيمة الصنف لنفس العملة الكمية إجمالى القيمة لنفس العملة
3860820 BiOMOL .KW conc دولار $1,500.00 500 $750,000.00
3860821 Avco Ron   WXF يورو € 1,200.00 100 € 120,000.00
3860823 كلوريد بوتاسيوم جنيه مصري  ج.م.‏ 1,200.00 750  ج.م.‏ 900,000.00
 
 
     فبرجاء من حضراتكم مساعدتى في حل هذه المشكلة تقبل الله منا ومنكم صالح الأعمال .
 
 
 
  تنسيق مبالغ العملات الأجنبية.xlsm   تحميل xlsm مرات التحميل :(6)
الحجم :(31.609) KB



أفضل إجابة مقدمة من YasserKhalil وهي:
وعليكم السلام أخي الكريم أشرف
جرب الكود التالي عله يفي بالغرض إن شاء الله
Option Explicit

Private Sub CommandButton1_Click()
    Dim sh As Worksheet, sCurrency As String, lr As Long
    Set sh = ThisWorkbook.Sheets("DATA")
    lr = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
    With Me
        sh.Range("A" & lr).Value = .TextBox4.Value
        sh.Range("B" & lr).Value = .TextBox1.Value
        sh.Range("C" & lr).Value = .ComboBox1.Value
        sh.Range("D" & lr).Value = .TextBox2.Value
        sh.Range("E" & lr).Value = .TextBox3.Value
        sh.Range("F" & lr).Value = .TextBox5.Value
        Select Case .ComboBox1.Value
            Case "جنيه مصري": sCurrency = " ج.م. #,##0.00"
            Case "دولار": sCurrency = "[$$-en-US]#,##0.00_ ;-[$$-en-US]#,##0.00 "
            Case "يورو": sCurrency = "[$€-nl-BE] #,##0.00;[$€-nl-BE] -#,##0.00"
            Case Else: sCurrency = Empty
        End Select
        If sCurrency <> Empty Then Union(sh.Range("D" & lr), sh.Range("F" & lr)).NumberFormat = sCurrency
        sh.Range("A" & lr).Resize(1, 6).Borders.Value = 1
        .TextBox1.Value = "": .TextBox2.Value = ""
        .TextBox3.Value = "": .TextBox4.Value = ""
        .TextBox5.Value = "": .ComboBox1.Value = ""
        Call Refresh_Data_Click
        .TextBox4.SetFocus
    End With
End Sub

Private Sub CommandButton3_Click()
    If Me.ListBox1.ListIndex < 0 Then MsgBox "لو سمحت اختار البيان المطلوب حذفه", vbCritical: Exit Sub
    Dim sh As Worksheet, selected_row As Long
    Set sh = ThisWorkbook.Sheets("DATA")
    selected_row = Application.WorksheetFunction.Match(Me.ListBox1.List(Me.ListBox1.ListIndex, 0), sh.Range("A:A"), 0)
    sh.Range("B" & selected_row).EntireRow.Delete
    Me.TextBox1.Value = ""
    Me.TextBox2.Value = ""
    Me.TextBox3.Value = ""
    Me.TextBox4.Value = ""
    Me.ComboBox1.Value = ""
    Call Refresh_Data_Click
End Sub

Private Sub CommandButton5_Click()
    Unload Me
    End
End Sub

Private Sub Refresh_Data_Click()
    Dim lr As Long
    Sheets("DATA").Activate
    ListBox1.ColumnCount = 2
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    With Me.ListBox1
        .ColumnHeads = True
        .RowSource = Range("A4:B" & lr).Address
    End With
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    If Me.ListBox1.List(Me.ListBox1.ListIndex, 0) <> "" Then
        Me.TextBox1.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
        Me.TextBox4.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 0)
    End If
End Sub

Private Sub TextBox2_AfterUpdate()
    TextBox5.Value = Val(TextBox2.Value) * Val(TextBox3.Value)
End Sub

Private Sub TextBox3_AfterUpdate()
    TextBox5.Value = Val(TextBox2.Value) * Val(TextBox3.Value)
End Sub

Private Sub UserForm_Activate()
    Me.TextBox4.SetFocus
    With Me.ComboBox1
        .Clear
        .AddItem "جنيه مصري"
        .AddItem "دولار"
        .AddItem "يورو"
        .AddItem ""
    End With
    Call Refresh_Data_Click
End Sub
عرض الإجابة




14-10-2021 03:28 صباحا
مشاهدة مشاركة منفردة [1]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10445
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 535
قوة السمعة : 36552
عدد الإجابات: 254
 offline 
look/images/icons/i1.gif تنسيق مبالغ العملات المحلية والأجنبية في شيت الأكسيل بعد الترحيل
وعليكم السلام أخي الكريم أشرف
جرب الكود التالي عله يفي بالغرض إن شاء الله
Option Explicit

Private Sub CommandButton1_Click()
    Dim sh As Worksheet, sCurrency As String, lr As Long
    Set sh = ThisWorkbook.Sheets("DATA")
    lr = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
    With Me
        sh.Range("A" & lr).Value = .TextBox4.Value
        sh.Range("B" & lr).Value = .TextBox1.Value
        sh.Range("C" & lr).Value = .ComboBox1.Value
        sh.Range("D" & lr).Value = .TextBox2.Value
        sh.Range("E" & lr).Value = .TextBox3.Value
        sh.Range("F" & lr).Value = .TextBox5.Value
        Select Case .ComboBox1.Value
            Case "جنيه مصري": sCurrency = " ج.م. #,##0.00"
            Case "دولار": sCurrency = "[$$-en-US]#,##0.00_ ;-[$$-en-US]#,##0.00 "
            Case "يورو": sCurrency = "[$€-nl-BE] #,##0.00;[$€-nl-BE] -#,##0.00"
            Case Else: sCurrency = Empty
        End Select
        If sCurrency <> Empty Then Union(sh.Range("D" & lr), sh.Range("F" & lr)).NumberFormat = sCurrency
        sh.Range("A" & lr).Resize(1, 6).Borders.Value = 1
        .TextBox1.Value = "": .TextBox2.Value = ""
        .TextBox3.Value = "": .TextBox4.Value = ""
        .TextBox5.Value = "": .ComboBox1.Value = ""
        Call Refresh_Data_Click
        .TextBox4.SetFocus
    End With
End Sub

Private Sub CommandButton3_Click()
    If Me.ListBox1.ListIndex < 0 Then MsgBox "لو سمحت اختار البيان المطلوب حذفه", vbCritical: Exit Sub
    Dim sh As Worksheet, selected_row As Long
    Set sh = ThisWorkbook.Sheets("DATA")
    selected_row = Application.WorksheetFunction.Match(Me.ListBox1.List(Me.ListBox1.ListIndex, 0), sh.Range("A:A"), 0)
    sh.Range("B" & selected_row).EntireRow.Delete
    Me.TextBox1.Value = ""
    Me.TextBox2.Value = ""
    Me.TextBox3.Value = ""
    Me.TextBox4.Value = ""
    Me.ComboBox1.Value = ""
    Call Refresh_Data_Click
End Sub

Private Sub CommandButton5_Click()
    Unload Me
    End
End Sub

Private Sub Refresh_Data_Click()
    Dim lr As Long
    Sheets("DATA").Activate
    ListBox1.ColumnCount = 2
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    With Me.ListBox1
        .ColumnHeads = True
        .RowSource = Range("A4:B" & lr).Address
    End With
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    If Me.ListBox1.List(Me.ListBox1.ListIndex, 0) <> "" Then
        Me.TextBox1.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 1)
        Me.TextBox4.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 0)
    End If
End Sub

Private Sub TextBox2_AfterUpdate()
    TextBox5.Value = Val(TextBox2.Value) * Val(TextBox3.Value)
End Sub

Private Sub TextBox3_AfterUpdate()
    TextBox5.Value = Val(TextBox2.Value) * Val(TextBox3.Value)
End Sub

Private Sub UserForm_Activate()
    Me.TextBox4.SetFocus
    With Me.ComboBox1
        .Clear
        .AddItem "جنيه مصري"
        .AddItem "دولار"
        .AddItem "يورو"
        .AddItem ""
    End With
    Call Refresh_Data_Click
End Sub

14-10-2021 07:27 صباحا
مشاهدة مشاركة منفردة [2]
ashraf_hertlion
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 18-09-2017
رقم العضوية : 540
المشاركات : 260
الجنس : ذكر
تاريخ الميلاد : 7-11-1971
يتابعهم : 14
يتابعونه : 1
قوة السمعة : 329
 offline 
look/images/icons/i1.gif تنسيق مبالغ العملات المحلية والأجنبية في شيت الأكسيل بعد الترحيل
الف مليون شكر يا استاذنا ياكبير هذا هو المطلوب بعينه
بجد وحقيقى لم اجد كلمات الشكر التى تكفى حضرتك وتوفيك قدرك بجد بجد حضرتك ملكشى حل وربنا يجعلة فى ميزان حسناتك الى يوم القيامة وكل سنة وحضرتك طيب
تقبل منى كل التحيات والشكر

14-10-2021 04:35 مساء
مشاهدة مشاركة منفردة [3]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10445
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 535
قوة السمعة : 36552
عدد الإجابات: 254
 offline 
look/images/icons/i1.gif تنسيق مبالغ العملات المحلية والأجنبية في شيت الأكسيل بعد الترحيل
بارك الله فيك أخي الكريم أشرف ومشكور على كلماتك الطيبة ودعائك الطيب المبارك ، والحمد لله الذي بنعمته تتم الصالحات.



الكلمات الدلالية
العملات ، مبالغ ، تنسيق ، الترحيل ، الأكسيل ، والأجنبية ، المحلية ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 08:21 صباحا