اذهب الي المحتوي
أوفيسنا

شرح طريقة عمل زر مزدوج


الردود الموصى بها

أخي الكريم/ الحديثة

أعتذر عن تأخر ردي لعدم وجودي بالمنتدى بعد ردك الأخير و حتى الآن

كما تفضل أستاذنا الحبيب / دغيدي بخصوص إضافة الكود

و يمكنك لإضافة الزر عمل إدراج شكل ( من قائمة إدراج ) و تختار رسم و لون الزر الذي تريد و بعد ذلك كليك يمين على شكل الزر الذي أخترته ثم تخصيص كود و أضف الكود للزر ( في حالة أستخدام أوفيس 2003 )

أقترح على حضرتك إضافة الكود هنا و سنرفع لك ملف به المطلوب إن شاء الله في الحالتين ( 2003 - 2007 أو أعلى )

رابط هذا التعليق
شارك

هذا هو الكود الرجاء يعض التعديلات علية لياخذ من صف الدرجات اى لا يتقديد ب 15 او 40 درجة فى الدرجة ةالترم2

Sub ÖÇÝÉ_ÍÐÝ2()

On Error Resume Next

Dim XX As Shape

Set XX = ActiveSheet.Shapes("ÇáÏÇÆÑÉ")

With XX.TextFrame.Characters

If .Text = "ÇÖÇÝÉ ÇáÏæÇÆÑ" Then

Circles2

.Text = "ÍÐÝ ÇáÏæÇÆÑ"

Else

RemoveCircles1

.Text = "ÇÖÇÝÉ ÇáÏæÇÆÑ"

End If

End With

On Error GoTo 0

End Sub

Sub Circles2()

Dim C As Range

Dim MyRng As Range, V As Shape

Dim X As Integer, G As Integer, R As Integer, D As Integer

'================================================

G = 2 ' ÚãæÏ ÑÞã ÇáÌáæÓ

R = 7 ' ÕÝ ÇáÏÑÌÇÊ

'================================================

X = Activewindow.Zoom

Application.ScreenUpdating = False

Activewindow.Zoom = 100

For Each C In Range("D5:AE154")

'If Cells(C.Row, G) = 0 Then GoTo 1

If Cells(4, C.Column).Value = "ÊÑã2" And C.Value <> "" And (C.Value < 15 Or C.Value = "Û" Or C.Value = "ÕÝÑ") Then

Set V = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, C.Left + 3, C.Top + 3, C.Width - 6, C.Height - 6)

V.Fill.Visible = msoFalse

V.Line.ForeColor.SchemeColor = 12

V.Line.Weight = 1.75

TT = TT + 1

End If

If Cells(4, C.Column).Value = "ÇáÏÑÌÉ" And C.Value <> "" And (C.Value < 40 Or C.Value = "Û" Or C.Value = "ÕÝÑ") Then

Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left + 3, C.Top + 3, C.Width - 6, C.Height - 6)

V.Fill.Visible = msoFalse

V.Line.ForeColor.SchemeColor = 10

V.Line.Weight = 1.75

D = D + 1

End If

1 Next

Activewindow.Zoom = X

Application.ScreenUpdating = True

MsgBox "Êã ÅÖÇÝÉ " & TT & " ãÑÈÚ æ " & D & " ÏÇÆÑÉ ÈäÌÇÍ", vbMsgBoxRtlReading, "ÇáÍãÏááå"

End Sub

رابط هذا التعليق
شارك

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

وطريقة الكتابة على الزر ليظهر مرة حذف ومرة اضافة

الثالث.rar

رابط هذا التعليق
شارك

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

الاستاذ والاخ العزيز ابو احمد حفظكم الله سبحانه وتعالى ورعاكم

عمل رائع , دوائر ومربعات بشكل جميل وباتقان جزاك الله خيرا

رابط هذا التعليق
شارك

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

الاستاذ والاخ العزيز ابو احمد حفظكم الله سبحانه وتعالى ورعاكم

عمل رائع , دوائر ومربعات بشكل جميل وباتقان جزاك الله خيرا

حياك الله اخي عباس

رابط هذا التعليق
شارك

بارك الله فيك أخي و استاذي الحبيب / أبوأحمد على كل ما تقدمه دائما للجميع من علم

أخي / الحديثة

تأخري في الرد عليك أفادنا نحن الأثنين معا برد أخي / عبد الله فهو أستاذي الذي اتعلم منه كسائر الإخوة هنا الكثير و الكثير دائما

بالنسبة لإستفسار حضرتك كما سبق و نوهت يمكنك بعد إنشاء شكل الزر الضغط عليه بكليك يمين و أختيار تعيين ماكرو

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information