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

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

قام بنشر

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

احبتي كل ما احاول جعل الايقونات في وسط اليوزرفورم تظهر لي في الطرف الايمن 

كما في الصورة 

20.jpg

قام بنشر (معدل)

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

يصعب التعامل مع الكود بدون ارفاق الملف لاكن حاول تجربة شيء كهدا

Private Sub UserForm_Activate()
Me.Label1.Left = (Me.Width / 2) - (Me.Label1.Width / 2)
Me.Label2.Left = (Me.Width / 2) - (Me.Label2.Width / 2)
Me.Label3.Left = (Me.Width / 2) - (Me.Label3.Width / 2)
Me.Label4.Left = (Me.Width / 2) - (Me.Label4.Width / 2)
End Sub

 'OR

Private Sub UserForm_Activate()
For c = 1 To 4
  Me("Label" & c).Left = (Me.Width / 2) - (Me("Label" & c).Width / 2)
  Next
End Sub

 

test.xlsm

تم تعديل بواسطه محمد هشام.
قام بنشر

تفضل اخي 

img?id=843656

Private Sub UserForm_Activate()
With Me
.startUpPosition = 3
.Width = Application.Width
.Height = Application.Height
.Left = 0
.Top = 0
End With
    For c = 1 To 4
  Me("Label" & c).Left = (Me.Width / 1.8) - (Me("Label" & c).Width / 2.4)
  Next
End Sub

 

1.rar

قام بنشر (معدل)

تسلم يمينك ياغالي بارك الله فيك وخدمك المال و البنون ..

لو حبيت يكونوا جنب بعض مثل كذا

تسجيل الطلاب        ــ      تسجيل المتابعة

التقارير الشهرية       ــ       قاعدة البيانات

 

كيف يكون التعديل على الكود ..؟

 

تم تعديل بواسطه الطراقي
قام بنشر (معدل)
For c = 1 To 2
    For j = 3 To 4
  Me("Label" & c).Left = (Me.Width / 1.5) - (Me("Label" & c).Width / 1.5)
  Me("Label" & j).Left = (Me.Width / 2) - (Me("Label" & j).Width / 1.6)
     Next
  Next

يمكنك تعديله بالشكل التالي  مع التلاعب قليلا بالمكان الاصلي  لعناصر label  على اليوزرفورم 

img?id=843804

1.rar

تم تعديل بواسطه محمد هشام.
  • Like 1
قام بنشر

شكرا استاذ محمد على تفاعلك و شرحك

اضقت صور بدل الكتابة .. لكن اختفى بعض الايقونات خلف بعض 

كما في الصورة ..

 

1.png

قام بنشر (معدل)

هل تقصد انك قمت باستبدال عناصر label بالصور 

ارفق ملفك مع الصور المرغوب اظافتها مع تحديد مكان تواجدها  لنتمكن من تعديل الكود بما يتناسب مع الوضع الحالي 

تم تعديل بواسطه محمد هشام.
قام بنشر

في هده الحالة سيتم الاستغناء عن عناصر label وتعويضها بالصور 

img?id=844805

ضع الكود التالي في Module 

Option Explicit
Public IM() As New Classe1
Sub USF()
Dim c As Control, n%
With UserForm7
    For Each c In .Controls
        If TypeName(c) = "Image" Then
            ReDim Preserve IM(n)
            Set IM(n).IM = c
            n = n + 1
        End If
    Next
End With
End Sub

وفي Classe Module 

Option Explicit
Public WithEvents IM As MSForms.Image
Private Sub IM_Click()
Dim c As Control
For Each c In IM.Parent.Parent.Controls
    If TypeName(c) = "Frame" Then c.BackColor = RGB(255, 255, 255)
Next
'Yellow
IM.Parent.BackColor = RGB(255, 255, 0) 'Red..........= RGB(255,0,0)
End Sub

مع تعديل الاكواد التالية بعد حدف عناصر label 

Private Sub UserForm_Initialize()
For c = 1 To 4
   Me("Image" & c).Visible = False
  Next
End Sub
'***********************
Private Sub UserForm_Activate()
Call USF
With Me
.startUpPosition = 3
.Width = Application.Width
.Height = Application.Height
.Left = 0
.Top = 0
End With
End Sub

ملاحظة 

Private Sub Workbook_Open()
'تم تعطيل الكود ليتمكن الجميع من الاستفادة  
Application.DisplayAlerts = False
Application.Visible = False
'If Date >= DateValue("15/06/2024") Or Sheets("names").Range("zz1") = "eta" Then
'Sheets("names").Range("zz1") = "eta"
'MsgBox "call me 00201113135517"
'ThisWorkbook.Save
'Application.Quit
'Else
UserForm7.Show
'End If
End Sub

 

2.xlsb

  • Like 1
قام بنشر

شااااكر ومقدر تجاوبك و تعاونك اخي محمد

وكل عام و انت بخير و صحة وسلامة

 

سيتم مراجعتها و التاكد منها بعد العيد بمشيئة الله

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