ملف جمع

[haidralsrag]

السلام عليكم اخوتي الاعزاء 

 

لدي موضوع تعبت منه بصراحة

 

هناك ملف اكسل قمت بئنشائة وهوه عبارة عن حقل عبارة عن زر وفي جانبه حقل ثاني يوجد به رقم كل ما اريده من عمل البرنامج وهوه بمجر الضغط على الحقل سيتحول من 1 الى 2 و كل ما اضغط على الزر يزيد الرقم 1

 

 

الملف مرفق تحياتي

الملف.zip

[ابراهيم الحداد]

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

انسخ هذا الكود وكرره بعدد الازرار المطلوب الترقيم بها

و لا تنسى تغيير اسم الخلية "J4" الى اسم الخلية المطلوبة

وتغيير اسم الكود باضافة رقم مثلا الى اسم الكود فى كل مرة تلصق فيها الكود

Sub CounNum()
Dim x As Long
x = Sheet1.Range("J4").Value
x = x + 1
Sheet1.Range("J4").Value = x
End Sub
Sub RoundDiagonalCornerRectangle87_Click()
Call CounNum
End Sub

 

 

[ياسر خليل أبو البراء]

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

بارك الله فيك أخي العزيز زيزو العجوز .. حل آخر إثراءً للموضوع ...

الأخ السائل : أولاً ستقوم بتغيير أسماء الأشكال الموجودة في ورقة العمل لديك لأن الأسماء الطويلة للأشكال ستسبب لك أخطاء في الخطوات التالية ، ويمكن تغيير أسماء الأشكال الموجودة في ورقة العمل بهذا الكود

Sub RenameAllShapes()
    Dim i           As Long
    
    For i = 1 To Sheet1.Shapes.Count
        Sheet1.Shapes(i).Name = "Shape" & i
    Next i
End Sub

الخطوة الثانية هي تعيين ماكرو لكل الأشكال مرة واحدة بدلاً من تعيين ماكرو لكل شكل على حدا باستخدام الماكرو التالي

Sub AssignMacroToAllShapes()
    Dim shp         As Shape
    
    For Each shp In ActiveSheet.Shapes
        shp.OnAction = "IncrementMe"
    Next shp
End Sub

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

Sub IncrementMe()
    Dim lRow        As Long
    Dim lCol        As Long

    Application.ScreenUpdating = False
        With Sheet1.Shapes(Application.Caller)
            lCol = .TopLeftCell.Column
            lRow = .TopLeftCell.Row
            
            Cells(lRow, lCol).Offset(, 1).Value = Cells(lRow, lCol).Offset(, 1).Value + 1
        End With
    Application.ScreenUpdating = True
End Sub

 ** ملحوظة قبل تنفيذ أي خطوة انسخ كل الأكواد في موديول قبل البدء في عملية التنفيذ .. بعد النسخ قم بتنفيذ الخطوة الأولى والثانية مرة واحدة فقط ...

أما الخطوة الثالثة ستكون مرتبطة بالأشكال الموجودة في ورقة العمل

تقبل تحياتي