توسيط الايقونات Label في وسط يوزرفورم الرئيسي

[الطراقي]

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

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

كما في الصورة 

[كمال على طارق]

وعليكم السلام وكيف يتم المساعدة بدون رفع الملف ؟!!!!

[محمد هشام.]

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

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

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

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

[الطراقي]

شكرا جزيل الشكر على تجاوبكم ..

المعذره اني مارفعت الملف 

رمز الدخول

12345

 الملف بالمرفقات

 

1.xlsb

[محمد هشام.]

تفضل اخي 

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

[الطراقي]

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

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

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

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

 

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

 

تم تعديل يونيو 14 بواسطه الطراقي

[محمد هشام.]

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  على اليوزرفورم 

1.rar

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

[الطراقي]

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

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

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

 

[محمد هشام.]

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

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

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

[الطراقي]

 

 

1.xlsb1.14 \u0645\u064a\u062c\u0627 \u0628\u0627\u064a\u062a · 3 downloads

[محمد هشام.]

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

ضع الكود التالي في 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

[الطراقي]

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

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

 

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