بروجرس بار بالنسبه المئويه

[علي فاهم]

يوجد بالمرفقات بروجرس بار مفيد جدا للاستاذ عبد الباري البنا  رائع ولكن اريد التعديل عليه  من فضلكم بحيث يعمل عند تنفيذ اكواد تانيه 

Progressbar.rar

[ناصر سعيد]

اخواني الكرام الملف مش شايف فيه الا ورقتين وموجود بالفيجوال اسماء اوراق كتير ... هل معنى هذا ان الاوراق مخفيه  ؟ ام ماذا ؟

هذا الملف راائع  لو واحد ابن حلال يشرح الكود

[أنس دروبي]

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

أخي الكريم الملف المرفق الذي أرفقته هو لمبرمج امريكي في الاساس 

لو كنت تريد اضافة "بروجرس بار" مع كود معين يعمل اثناء تشغيله 

اليك بهذا الملف المرفق 

وهذا رابط الموضوع

شريط تقدم تثبيت البيانات

 

شريط تقدم تثبيت ونسخ البيانات.rar

[علي فاهم]

Private Sub CommandButton1_Click()
Frame1.Visible = True
Label1.Visible = True
For rep = 1 To 100
Call UpdatePercentage(rep * 0.01)
Timeout 0.1  ' هنا تستطيع تغيير معدل الوقت لكل درجة مئوية هنا وضعته ثانية واحدة فقط
Call anas2 ' أثناء النقر سوف يعمل هذا الماكرو أنظر في الاسفل
Call anas ' هذا ماكرو المعادلات التي سوف تنفذ اثناء تقدم الشريط
Next rep
End Sub
Sub Timeout(seconds As Double)
Start_Time = Timer
Do
DoEvents
Loop Until (Timer - Start_Time) >= seconds
End Sub
Sub UpdatePercentage(what_percent As Double)
Dim output_percentage As Integer
Dim new_width As Integer
control_width = 180 'تستطيع تغيير رقم العرض (180) حسب عرض الفيرم وعرض اليبل (1)
new_width = what_percent * 180
output_percentage = what_percent * 100
Label1.Width = new_width
Label1.Caption = output_percentage & "%"
End Sub
'هذا كود المعادلات التي تعمل أثناء ظهور شريط التقدم حسب كل نسبة مئوية
'تستطيع كتابة أية معادلة تريدها لكي تنفذ أثناء العمل
Sub anas()
'هذه معادلة الكتابة في المدى المحدد عند وصول الشريط الى درجة 30%
If Label1.Caption = "20%" Then
Label2.Visible = True
Label2.Caption = "جاري البدء لعملية النسخ"
ElseIf Label1.Caption = "30%" Then
Sheets("sheet1").Range("A1") = "الاسم"
Sheets("sheet1").Range("B1") = "المبلغ"
ElseIf Label1.Caption = "50%" Then
Label2.Caption = "يتم الآن نسخ البيانات"
Sheets("sheet1").Range("A2:A10") = "Anas Droubi"
Sheets("sheet1").Range("B2:B10") = "1000"
ElseIf Label1.Caption = "70%" Then
Label2.Caption = "يتم الآن لصق البيانات في المكان المحدد"
Sheets("sheet1").Range("A11") = "المبلغ الإجمالي"
Sheets("sheet1").Range("B11").Formula = "=SUM(B2:B10)"
ElseIf Label1.Caption = "85%" Then
Label2.Caption = "جاري التقدم لإنتهاء تثبيت البيانات"
ElseIf Label1.Caption = "100%" Then
Label2.Caption = "أنتهى التثبيت بنجاح"
End If
End Sub

Private Sub Label1_Click()

End Sub

Private Sub Label2_Click()

End Sub

'الكود الذي يعمل أثناء تشغيل الفورم
Private Sub UserForm_Activate()
Frame1.Visible = False
Label1.Visible = False
Label2.Visible = False
End Sub
'هذا كود عند النقر على زر بدء عملية نسخ البيانات
Sub anas2()
If CommandButton1.TakeFocusOnClick Then  'عندما ننقر على الزر سوف يختفي لحتى ينتهي تقدم شريط التثبيت
CommandButton1.Visible = False
End If
If Label1.Caption = "100%" Then  'وعند وصول اليبل رقم 1 الى نسبة 100% سوف يظهر زر بدء عملية التثبيت مرة ثانية
CommandButton1.Visible = True
End If
End Sub

جزاك الله كل خير وبارك الله فيك .. ارجو وضع كود الترحيل الموجود بالمرفق مع شريط التقدم .

عايز اضغظ على زر الترحيل واثناء الترحيل يظهر البروجرس ويعد الى ان ينتهي 100% ثم يختفي البروجرس

 

كود الترحيل بالبروجرس1.rar

[علي فاهم]

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

ارجوك .. اشرحه  ... عامل زي الشفرات بالنسبه لي

[علي فاهم]

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Const GWL_STYLE = -16
Const WS_CAPTION = &HC00000
Const WS_SYSMENU = &H80000

Private Sub Frame1_Click()

End Sub

Private Sub Im1_Click()

End Sub

Private Sub UserForm_Activate()
Application.Visible = False
Nour_A
End Sub
Sub Nour_A()
On Error Resume Next
secondes = 0.05
 For a = 1 To 100
timer_avant = Timer
 Do While Timer < timer_avant + secondes
    DoEvents
     Me.Im1.Width = a + a + a / 2.2
   Me.Nour1.Caption = a
   Loop
Next
'Application.Visible = True
'Sheet1.Activate
Me.Hide
UserForm2.Show
End Sub
Private Sub UserForm_Initialize()
dawenleod.Left = 0
dawenleod.Top = 0
  Dim lngWindow As Long, lFrmHdl As Long
    lFrmHdl = FindWindow(vbNullString, Me.Caption)
    lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
    lngWindow = lngWindow And (Not WS_CAPTION)
    Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)
    Call DrawMenuBar(lFrmHdl)
Me.Height = 210
End Sub

ده الكود واثناء التشغيل يظهر اسم عبد الباري والكود لايوجد به الاسم دلوني حفظكم الله

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

أخي الكريم أين الملف المرفق الذي تتحدث عنه ويظهر فيه اسم أخونا عبد الباري ..قمت بتحميل الملفين في الموضوع ولم أجد ما تتحدث عنه ؟

مجرد احتمال أن يكون اسم عبد الباري موجود في أحد الليبلات الموجودة بالفورم ويكون مخفي ويظهر عند تشغيل الفورم !!

 

[ناصر سعيد]

هل يمكن نطويع الكود الخاص بالبوجرس بار ليتناسب مع اي كود

[أنس دروبي]

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

أخي الكريم  alyfahem

شاهد الملف المرفق أتمنى أن يكون كما طلبت 

سوف يتم تنفيذ كود الترحيل أثناء ظهور شريط البروجرس وينتهي الترحيل عند الوصول الى 100%

وبالنسبة لملف أستاذنا عبد الباري 

القصد كان من كلامي في المشاركة السابقة أن الاستاذ عبد الباري قام بنشر الموضوع والفكرة فقط في ذلك الوقت 

ولم يكن هو المبرمج كما فهمت مني 

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

وبالنسبة لسؤال أخي ناصر سعيد حول تطويع الفورم والكود على أي ملف 

في الملف المرفق التالي أكبر مثال على ذلك 

تقبلو تحياتي ومروري 

 

 

 

 

 

 

 

كود الترحيل بالبروجرس1.zip

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

أخي الكريم أنس

جرب تنفيذ الكود بدون الفورم مرة وبالفورم مرة ؟ ولاحظ الفرق في التوقيت

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

 

[أنس دروبي]

أخي الغالي ياسر خليل كلامك صحيح 

أنتبهت له والله قبل الرفع وقمت بتجربة الترحيل بدون الشريط ومع الشريط وظهر الفرق

ولكن أنا قمت برفع الملف بناء على طلب أخونا alyfahem فقط 

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

الكود يعتبر سريع جداً ولايأخذ وقت بدون البروجرس

البروجرس استخدمته منذ فترة ماضية في تشغيل عدة كودات مع بعض فكان كمنظر وإداء جميل جداً

وعندما تشاهده تظن نفسك أمام برنامج متكامل

هذه الغاية منه على مااعتقد 

 

[ناصر سعيد]

هل يمكن نطويع الكود الخاص بالبوجرس بار ليتناسب مع اي كود

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

1 لانه يعمل منفردا بدون اي اهتزازات

2 متزامن مع العمليه التي يقوم بها شكله اوضح

كود الترحيل سريع الان لانه لوحده لكن عند وجود برنامج متكامل به اكواد كثيره يصبح بطيء .. لو يوجد فكره تزيد السرعه

[ناصر سعيد]

هل يمكن وضع ملف 2003 لهذا الشرح البسيط اعزكم الله

 

[علي فاهم]

ربنا يحفظك استاذ أنس دروبي  

[omar elhosseini]

بسم الله الرحمن الرحيم

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

اسمحو لي بمشاركة بسيطه

الاخ  alyfahem

بعد التحيه

ارجو تجربة المرفقات

وهى تحتوي علي ملفين

الاول هو ملفك بعد عمل المطلوب

الثاني ملف ل Progress indicator بسيط

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

 

Omar_1.rar

[omar elhosseini]

اليك اخي alyfahem

نسخه اخري من ملفك ب Progress indicator  ثاني مختلف عن الاول

ومعه ملف منفصل ل Progress indicator

Omar_2.rar

[ناصر سعيد]

ربنا يبارك فيك الاستاذ الكبير   ا لعملاق عمر الحسيني

روعه .. ونحن في انتظار الشرح

والله روعه

 

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

أحقاً ما تراه عيني أم أنني ما زلت نائماً وأغط في أحلامي؟!!

أخي الحبيب ومعلمي الكبير عمر الحسيني أبو تامر بيننا .. لابد وأنه يوم عيد ..

لا تعلم مدى سعادتي بوجودك فيما بيننا فأنت صرح كبير وعلم فذ من أعلام أوفيسنا

عوداً حميداً ..عوداً حميداً ..عوداً حميداً

وليتك تبقى بين إخوانك

تقبل وافر تقديري وحبي واحترامي

 

[omar elhosseini]

الاخ ناصر سعيد

شكرا لك

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

شكر لك علي ترحيبك الكريم

اراك نبراسا يضئ الطريق للاخوة

شكرالك اخي

 

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

إن كنت قمراً فأنت الشمس يا عمر ..

والله سعادتي لا توصف بتواجدك بيننا

أدام الله المحبة بيننا وجمع بيننا في الآخرة في مستقر رحمته في الفردوس الأعلى من الجنة

أتمنى دوام تواجدك فيما بيننا ...اقطع وعداً بأن تكون بيننا ولو مرة واحدة في الأسبوع

تقبل تحياتي

[omar elhosseini]

إن شاء الله اخي