اذهب الي المحتوي
أوفيسنا

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

قام بنشر

السلام عليكم ورحمة الله وبركاته اخواني الكرام أسعد الله أوقاتكم

 أطلب منكم المساعدة في تنسيق الشهر في فورم الإكسل حيث الشهر يظهر لي أرقام في القائمة المنسدلة ( في الفورم ) " الملف مرفق  وشكرا.

تنسيق الشهر.xlsb

قام بنشر

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

 بعد معاينة الملف اظن انك في حاجة الى اعادة النظر في طريقة جلب البيانات الى الليست بوكس 

اما بخصوص تنسيق الشهر يمكنك تجربة شيء كهدا  سيوفي بالغرض

Private Sub UserForm_Initialize()
 Dim cel As Range
 Set f = Sheets("2")
' For Each cel In f.Range("S4:S" & f.[S65000].End(xlUp).Row)
 'OR
For Each cel In Range("moi")
    If cel.Value <> "" Then
        ComboBox1.AddItem Format(cel, "mmmm")
     End If
    Next cel
End Sub

 

  • Like 1
قام بنشر

بارك الله فيك أستاذ 

لكن الكود يعطيني رسالة الخطأ

ofic.jpg

قام بنشر (معدل)

قم بحذف الارتباط الذي وضعته من قبل  من الكومبوبوكس 

(rowsource moi) للحصول على أسماء الشهور 

كما سبق الذكر طريقة فلترة البيانات خاطئة حاول شرح ما تحاول فعله ربما نستطيع مساعدتك 

تم تعديل بواسطه محمد هشام.
  • Like 1
  • أفضل إجابة
قام بنشر (معدل)

العفو اخي @AMIRBM يسعدنا اننا استطعنا مساعدتك 

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

Option Explicit
Dim myFormat(1) As String
Dim Arr As Variant

Private Sub UserForm_Initialize()
Dim OneRng(), i As Integer, n As Integer
Dim f As Worksheet: Set f = Sheets("1")  '<====' نطاق البيانات
 OneRng = f.Range("A3:F" & f.Range("B" & f.Rows.Count).End(xlUp).Row).Value
 ListBox1.List = OneRng
  cbxShtName.Value = f.Name
     With ListBox1
        .ColumnCount = 6
        .ColumnWidths = "60;170;140;90;90;90"
        .BorderStyle = fmBorderStyleSingle
    End With
    '<====' رؤوس الاعمدة
    For i = 1 To 6: Me("label" & i) = f.Cells(2, i): Next i
End Sub
'=========================
Private Sub colRecherche(Tbl As Long, Cpt As Long)
    Dim cnt As Long, dict As Long
    cnt = UBound(Arr, 2)
    With ListBox1
        .AddItem
        For dict = 1 To cnt
            .List(Tbl, dict - 1) = Arr(Cpt, dict)
        Next dict
        .List(Tbl, 1) = Format$(.List(Tbl, 1), _
                     "dddd, mmmm dd, yyyy")  '<====' التاريخ
        .List(Tbl, 4) = Format$(.List(Tbl, 4), "0.00") '<====' مبلغ الوحدة
        .List(Tbl, 5) = Format$(.List(Tbl, 5), "0.00") '<====' المجموع
    End With
End Sub
 '=========================
Private Sub Filtre()
    Dim Cpt As Long, dict As Long, tmp As Long, cnt As Long, n As Long
    Dim Clé As Boolean, Réf As Boolean, sFilter As String

    Clé = Len(ComboBox1.Value)
    Réf = Len(tbxSearch)
    
    tmp = UBound(Arr, 1): cnt = UBound(Arr, 2)
     With Me.ListBox1
        If .ListCount > 0 Then
            .RowSource = ""
            .Clear
        End If
        'فلترة باسم الشهر
    If Clé Then sFilter = ComboBox1.Value
    For Cpt = 3 To tmp
        If Clé Then
            If Format(CDate(Arr(Cpt, 2)), "mmmm") Like sFilter Then
                colRecherche n, Cpt
                n = n + 1
           End If
        Else
            colRecherche n, Cpt
            n = n + 1
        End If
    Next Cpt
If Réf Then
    'فلترة باسم البضاعة
        sFilter = tbxSearch
        For n = .ListCount - 1 To 0 Step -1
           If Not UCase(.List(n, 2) Like UCase("*" & sFilter & "*")) Then
                .RemoveItem (n)
            End If
        Next n
    End If
End With
    Count.Caption = ListBox1.ListCount: SumColumns
End Sub
 '=========================
Private Sub cbxShtName_Change()
  Dim xMonth As Object
  'اسماء الشهور المتوفرة
  Dim Cpt As Long, tmp As Long
  Dim WS As Worksheet: Set WS = Sheets("1")
    With WS.Range("A1:F" & WS.[B650000].End(xlUp).Row)
       Arr = .Value
       tmp = UBound(Arr, 1)
    Filtre
    Set xMonth = CreateObject("Scripting.Dictionary")
    xMonth("*") = ""
    For Cpt = 3 To tmp
    ' '<====' تنسيق اسم الشهر
        xMonth(Format(CDate(Arr(Cpt, 2)), "mmmm")) = Empty
    Next Cpt
    Me.ComboBox1.List = xMonth.keys
    End With
End Sub
'=========================
Private Sub CommandButton1_Click()
Dim WS As Worksheet: Set WS = Sheets("2")
If ListBox1.ListCount = 0 Then: Exit Sub
If MsgBox("ترحيل البيانات" & " ؟", vbYesNo) = vbNo Then Exit Sub
  WS.Range("B5:G" & WS.Rows.Count).ClearContents
  WS.[b5].Resize(Me.ListBox1.ListCount, 6) = Me.ListBox1.List
End Sub

 

 

تنسيق الشهر V2.xlsb

تم تعديل بواسطه محمد هشام.
  • Like 2

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