(تمت الإجابة) عمل تقرير

[abouelhassan]

احتاج اخى لكود

يضيف كلمة الاجمالى للصفحات بعد اخر صف مستخدم فى العمود B من خلال فورم

ولو امكن اخى امكانية اختيار الصفحات او الاضافة لكل الصفحات يخيرنى

وبكده اكون انتهيت تمام من البرنامج بفضل الله وفضلكم اخوانى الافاضل

[طارق محمود]

السلام عليكم

جزاك الله خيرا أخي أبا الحسن

ولك مثل مادعوت وأكثر بإذن الله

احتاج اخى لكود

يضيف كلمة الاجمالى للصفحات بعد اخر صف مستخدم فى العمود B من خلال فورم

بالفعل هذا موجود ضمن الملف

إرجع للمشاركة رقم #29 في الصفحة الثانية من الموضوع

وهذا هو الكود

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

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'Next r

If Target.Column <> 1 Or Target.Row < 5 Then Exit Sub

Dim Tot(99) As Integer


    'تسجيل اماكن إنتهاء الشهر والتي سيكون بها الإجمالي

    LstR = [a1000].End(xlUp).Row

    For a = 5 To LstR - 1

	    If Month(Cells(a, 1)) <> Month(Cells(a + 1, 1)) Then X = X + 1: Tot(X) = a

    Next a

    X = X + 1

    Tot(X) = LstR


For y = X To 1 Step -1

    If Cells(Tot(y), 2) <> "الاجمالى" Then

	    Cells(Tot(y) + 1, 1).Range("A1:H1").Insert Shift:=xlDown

	    Cells(Tot(y) + 1, 1).Range("A1:H1").Interior.ColorIndex = 8


	    Cells(Tot(y) + 1, 2) = "الاجمالى"


	    LstDat = Cells(Tot(y), 1).Value

	    m = Month(LstDat): yr = Year(LstDat)

	    If m = 12 Then m = 0

	    Cells(Tot(y) + 1, 1).Value = DateValue("01-" & m + 1 & "-" & yr) - 1

    End If

Next y


'تسجيل اماكن بها الإجمالي

LstR = [a1000].End(xlUp).Row

Tot(0) = 5

    X = 0

    For a = 5 To LstR

	    If Cells(a, 2) = "الاجمالى" Then X = X + 1: Tot(X) = a

    Next a


For y = 1 To X

    For b = 1 To 4 '			  ' ب1 ، ب2 ، ب3 ، ب4

	    rr = Tot(y) - Tot(y - 1) - 1

	    Cells(Tot(y), b + 4).FormulaR1C1 = "=SUM(R[-" & rr & "]C:R[-1]C)"



    Next b


Next y


End Sub

[الـعيدروس]

السلام عليكم

الاستاذ القدير طارق محمود جزاك الله خير على هذا العمل

مجهود كبير وفقك الله

الاخ الفاضل

عملت فورم وعليه 2 تكست بوكس تحديد عدد الاوراق المراد اما اضافة الاجماليات او حذفها مثلا :

من ورقة رقم 2 الى ورقة رقم 10

جرب واخبرني النتيجه

الارتباطات_alidroos.rar

[abouelhassan]

السلام عليكم

الاستاذ القدير طارق محمود جزاك الله خير على هذا العمل

مجهود كبير وفقك الله

الاخ الفاضل

عملت فورم وعليه 2 تكست بوكس تحديد عدد الاوراق المراد اما اضافة الاجماليات او حذفها مثلا :

من ورقة رقم 2 الى ورقة رقم 10

جرب واخبرني النتيجه

شكر وتقدير وفائق الاحترام استاذ ali

بارك الله فيك

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

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal lngWinIdx As Long, ByVal dwNewLong As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Dim hWnd As Long: Const GWL_STYLE = -16: Const WS_SYSMENU = &H80000

Private Sub CommandButton1_Click()

On Error Resume Next

Application.ScreenUpdating = False

Application.EnableEvents = False

For sh = Text_ِali To Text_ِali1 + 1

If Text_ِali.Text = Empty Or Text_ِali1.Text = Empty Then MsgBox "يرجاء تحديد أرقام الأوراق": Exit Sub

With Sheets(sh)

T = .Range("b15000").End(xlUp).Row + 1

.Cells(T, "b") = "الاجمالى"

End With

Next sh

Application.ScreenUpdating = True

Application.EnableEvents = True

End Sub

المطلوب ان يكون عدد الاوراق 39 ورقة بداية من الورقة2 وحتى 39

بعداذنك اخى

وبارك الله لنا فيك اخى فى الله

[الـعيدروس]

حدد في التكست الاول 2

والتكست الاخر 39

واضغط الزر إدخال الإجماليات

[abouelhassan]

شكر وتقدير وفائق الاحترام

:fff: استاذ

بارك الله فيك اخى مشكور جدا

تم العمل الحمد لله

اشكرك

[طارق محمود]

السلام عليكم

أخي أبو الحسن

أبشر

تلقيت رسالتك ولكني مشغول جدا

وسوف أرد عليك في القريب العاجل

[ahmed saif]

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