تنسيق الشهر في فورم الإكسل

[AMIRBM]

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

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

تنسيق الشهر.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

 

[AMIRBM]

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

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

[محمد هشام.]

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

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

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

تم تعديل أغسطس 6 بواسطه محمد هشام.

[AMIRBM]

بارك الله فيك أستاذ وجزاك الله خيرا

[محمد هشام.]

العفو اخي @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

تم تعديل أغسطس 7 بواسطه محمد هشام.

[AMIRBM]

شكرا جزيلا أستاذ

بارك الله فيكم