تنسيق رقم داخل دائرة

[ابوحبيبه]

السلام عليكم

هذا الملف به كود لعمل دوائر على ارقام في جدول قد عدلت انت عليه وقد استفدت منه كثيرا ... لكني وجدت الارقام داخل الدائرة تنسيقها جهة اليمين واعلى كما بالصورة ... والمطلوب تنسيقها وسط الدائرة

بالتعديل على الكود بالملف المرفق

circle (2).xlsm

ولك جزيل الشكر

[lionheart]

Try this

Option Explicit

Sub Add_Circles()
    Dim ws As Worksheet, myRng As Range, c As Range, v As Shape, col As Long
    Application.ScreenUpdating = False
        Set ws = ActiveSheet
        Set myRng = ws.Range("F3:N13")
        myRng.RowHeight = 35: myRng.ColumnWidth = 10
        Call Remove_Circles
        For Each c In myRng.Cells
            col = c.Column
            If c.Value < ws.Cells(2, col) Or c.Value = Chr(219) Then
                Set v = ws.Shapes.AddShape(msoShapeOval, c.Left + 15, c.Top + 2, 30, 30)
                With v
                    With .Fill
                        .Visible = msoTrue
                        .ForeColor.RGB = RGB(166, 166, 166)
                    End With
                    With .TextFrame2
                        .TextRange.ParagraphFormat.Alignment = msoAlignCenter
                        With .TextRange.Font
                            .Fill.ForeColor.RGB = RGB(0, 0, 0)
                            .Size = c.Font.Size
                            .Bold = c.Font.Bold
                            .Name = c.Font.Name
                        End With
                        .WordWrap = msoFalse
                    End With
                    With .TextFrame
                        .Characters.Text = c.Value
                        .MarginRight = 4
                        .MarginTop = 2
                        .MarginLeft = 4
                        .MarginBottom = 2
                    End With
                End With
            End If
        Next c
    Application.ScreenUpdating = True
End Sub

Sub Remove_Circles()
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        If shp.AutoShapeType = msoShapeOval Then shp.Delete
    Next shp
End Sub

 

[بلانك]

May God bless you

[ابوحبيبه]

شكرا على الاهتمام  ...

الارقام فعلا ظهرت في منتصف الدائرة . لكنها ليست في وضع توسيط كما بالصورة

فانا اريدها كذلك

ولك الشكر

[lionheart]

Change the column width and addshape line to suit you

[ابوحبيبه]

شكرا اخيي على الاهتمام  ...

 

لكن للاسف فعلت المطلوب ولم اتوصل لحل

.

اريد كود لوضع الرقم داخل الدائرة في وضع التوسيط

 

[lionheart]

The code already did that

Not clear problem for me. Wait for other members