طلب شرح فورم تتغير محتوياته حسب اعمدة الشيت

[ياسر أحمد الشيخ]

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

لقد وجدت موضوع فيديو رائع فى المنتدى بعنوان 

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

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

أرجو شرح الطريقه وارفاق تطبيق عملى عليه

وشكرا

تم تعديل فبراير 9, 2015 بواسطه leprince2007

[ياسر أحمد الشيخ]

هذا هو رابط الفيديو للاختصار

http://www.gulfup.com/?elUwUT

الرجاء شرح طريقة عمل هذا الفورم +مثال عملى

وشكراً

تم تعديل فبراير 11, 2015 بواسطه leprince2007

[ياسر أحمد الشيخ]

طيب يا جماعه عايز ملف به هذا الفورم الذى تتغير محتوياته على حسب أعمدة الشيت 

وانا أحاول افهم الكود إن شاء الله

أرجوكم ساعدونى

[الجموعي]

شاهد الموضوع التالي راح يفيدك

http://www.officena.net/ib/index.php?showtopic=58849&hl=

[ياسر أحمد الشيخ]

بعد اذن الأخ صاحب الملف

لقد وجدت الفورم فى المنتدى 

الحمد لله أخيرا

ملف رائع جدا

وهذا هو الكود أرجو كتابه الشرح الخاص بكل سطر

Option Explicit
'******************************************************
'  اسم ورقة البيانات
Const Sh_MyDate As String = "بيانات اساسية"
'------------------------------------------------------
'  رقم صف رؤوس الاعمدة
Const lrow As Integer = 5
'------------------------------------------------------
'  عدد الاعمدة التي تريدها ابتداءا من العمود الاول
Const lcol As Integer = 28
'******************************************************

Private k As Integer
Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub CommandButton3_Click()
Dim j As Integer
k = ScrollBar1.Value
label_Scrol_Value.Caption = "رقم :  " & k
Application.ScreenUpdating = False
For j = 1 To lcol
    If Me.Controls("Textbox" & j).Locked = False Then
        Worksheets(Sh_MyDate).Cells(k + lrow, j) = Me.Controls("Textbox" & j).Value
    End If
Next j
Application.ScreenUpdating = True
ScrollBar1_Change
End Sub

Private Sub CommandButton4_Click()
k = ScrollBar1.Value
Worksheets(Sh_MyDate).Cells(k + lrow, 1).EntireRow.Delete
ScrollBar1_Change
End Sub
Private Sub ScrollBar1_Change()
Dim j As Integer
k = ScrollBar1.Value
label_Scrol_Value.Caption = "رقم :  " & k
With Worksheets(Sh_MyDate)
    .Cells(k + lrow, 1).Select
    For j = 1 To lcol
        Me.Controls("Textbox" & j).Value = .Cells(k + lrow, j).Value
    
    Next j
End With
Frame1.ScrollTop = 0
End Sub


Private Sub UserForm_Activate()
ScrollBar1_Change
End Sub

Private Sub UserForm_Initialize()
Dim MyLabel As Control, MyTxtbox As Control
Dim i As Integer, MyTop As Integer, MyFrame_Top As Integer
MyTop = 20
MyFrame_Top = 12
Frame1.ScrollHeight = (lcol * MyTop) + MyFrame_Top
If Frame1.ScrollHeight > Frame1.Height Then Frame1.SpecialEffect = 3
For i = 1 To lcol
    Set MyLabel = Frame1.Controls.Add("Forms.label.1", "label" & i, True)
    With MyLabel
        .BorderStyle = 1
        .Move 180, MyFrame_Top, 80
        .Caption = Worksheets(Sh_MyDate).Cells(lrow, i).Value
        .TextAlign = fmTextAlignCenter
        .Font.Bold = True
        .Font.Size = 12
        .FontName = "Times New Roman"
        .ForeColor = vbRed
    End With
    Set MyTxtbox = Frame1.Controls.Add("Forms.TextBox.1", "TextBox" & i, True)
    With MyTxtbox
        .Move 0, MyFrame_Top, 180
        .TextAlign = fmTextAlignCenter
        .Font.Bold = True
        .Font.Size = 12
        .FontName = "Times New Roman"
        If Worksheets(Sh_MyDate).Cells(lrow + 1, i).HasFormula Then
            .BackColor = &HFFC0C0
            .Locked = True
        End If
    End With
    MyFrame_Top = MyFrame_Top + MyTop
    
Next i
End Sub

ارجو كتابه الشرح فى الملف نفسه

اعداد تقارير مدرسية.rar

[moslimway11]

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

أحب أن أضم صوتي لصوت الأخ  leprince2007

في عمل شرح للأكواد داخل الملف وأرجو توضيح كيفية توسيع مجال الأعمدة لانني أضفت أعمدة جديدة ولم تتدخل ضمن الفورم

وجزاكم الله خيرا

تم تعديل فبراير 18, 2015 بواسطه moslimway11

[ياسر أحمد الشيخ]

شكرا لانضمامك أخى معى لحل هذه المشكلة

ولكن أخى مشكلتك غير مشكلتى

مشكلتك يمكن حلها 

انظر إلى الكود

 

 

Option Explicit
'******************************************************
'  اسم ورقة البيانات
Const Sh_MyDate As String = "بيانات اساسية"
'------------------------------------------------------
'  رقم صف رؤوس الاعمدة
Const lrow As Integer = 5
'------------------------------------------------------
'  عدد الاعمدة التي تريدها ابتداءا من العمود الاول
Const lcol As Integer = 28
'******************************************************

يمكنك التغيير فى الرقم 28 فى آخر سطر فى الكود لتحديد عدد الأعمده التى تريدها:

Const lcol As Integer = 28

ولكن مشكلتى أخى أن نطق البيانات عندى عبارة عن 4 أعمده اريد عمل labels لكل خليه تقع تحت هذه الأعمدة 

[ابو نبأ]

السلام عليكم

عمل ممتاز ورائع

جزاكم الله خيرا

[moslimway11]

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

نعم أخي leprince2007 وصلت لها بعد تدقيق النظر في الكود ولكن فعلا نريد شرح كامل للكود من أساتذتنا الكرم  وهذا لروعة الكود بصراحة

وجزاكم الله خيرا