Ashraf Ehab

تم الحل .left

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

الاخوة الاعزاء برجاء مساعدتي في هذا الكود 

انا بعمل يبول في الفورم اول ما اكبر الشاشة بيتغير مكانه وانا عاوزه  اما يكبر يبقي بنفس شكل وهو عادي 

مرفق الملف 

تم شكرا لحضرتك ولك جزيل الشكر

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

الاخوة الاعزاء : ارجو مساعدتي في هذا الكود 

اريد عمل اذا وقف الماوس علي البوتون يطهر الفريم وهذا قم به ولكن اريد اذا المؤشر بعد عن البوتون يخفي الفريم 

مدرج الملفtry.xlsm

طيب هل موجود ما هو مطلوب او يمكن عمله من عدمه شكرا

رفع

Up

؟؟؟؟

رفع

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

اخواتي الاعزاء برجاء المساعدة في طلبي هذا : اريد ان اقوم بعمل نسخ للشيت ونقله علي جهاز اخر ويتم مشاركة البيانات علي نفس الشيت عند الجهازين في نفس الوقت عبر الانترنت علي ثبيل المثال جهاز 1 قام بعملية بيع جهاز 2 يري انه تم البيع وعدد الاصناف نقصة وهكذا واا لم يكن هناك انترنت يتم تحديث العمليات عند توافر الانترنت

شكرا وجزاكم الله خيرا  

مرفق لينك تحميل الملف

https://www.mediafire.com/file/bg4i539n0q4l81l/حسابات.xlsm/file

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

الفديو باللنك الاتي

https://www.mediafire.com/file/0staghp7nxyx4sa/es.rar/file

أخي العزيز ليس هذا ما هو مطلوب ساشرح لك بالتفاصيل 

١ هناك ٣ليبول بأرقام مختلفة 

٢ ليبول رقم ٧ به ٣٥ ثانية إذا وصلت إلي ٠ إبداء الايكونة بالتحرك حتي انتهاء الوقت الذي باليبول ٨ اي ٨ ثواني  بعد انتهاء ال ٨ثواني وبداء بعد ١٦ ثانية في ليبول ٩ ليبداء عد ال٣٥ ثانية من جديد وهكذا حتي ولكن في هذه الحالة إبداء الايكونة بالتحرك من آخر نقطة كانت متوقفة بها حتي اغلاق البرنامج

اخي العزيز لقد قمت بحلها ولكن ظهر امامى مشكلة لا استطيع حلها وهي كل شئ عند الفتح تمام لكن بعد ما يجي يبداء من جديد يتوقف 

وسرعة حركة ايكونة الاكسيل لا استطيع التحكم بسرعتها مرفق الملف بعد التعديل

WindowsApplication1.rar

انا عاجز عن شكرك هذا هو المطلوب لكني استاذن حضرتك تشرحلي معني الاكواد دي 

 Function Imges(ImageNo As Integer)
        Image1.Image = Nothing
        Image2.Image = Nothing
        Image3.Image = Nothing
        Image4.Image = Nothing
        Image5.Image = Nothing
        Image6.Image = Nothing
        Image7.Image = Nothing
        Image8.Image = Nothing
        Image9.Image = Nothing
        Select Case ImageNo
            Case Is = 1 : Image1.Image = Image.FromFile(newpoth & "\Excel_Icon.png")
            Case Is = 2 : Image2.Image = Image.FromFile(newpoth & "\Excel_Icon.png")
            Case Is = 3 : Image3.Image = Image.FromFile(newpoth & "\Excel_Icon.png")
            Case Is = 4 : Image4.Image = Image.FromFile(newpoth & "\Excel_Icon.png")
            Case Is = 5 : Image5.Image = Image.FromFile(newpoth & "\Excel_Icon.png")
            Case Is = 6 : Image6.Image = Image.FromFile(newpoth & "\Excel_Icon.png")
            Case Is = 7 : Image7.Image = Image.FromFile(newpoth & "\Excel_Icon.png")
            Case Is = 8 : Image8.Image = Image.FromFile(newpoth & "\Excel_Icon.png")
            Case Is = 9 : Image9.Image = Image.FromFile(newpoth & "\Excel_Icon.png")
            Case Is = 0 : PictureBox1.Image = Image.FromFile(newpoth & "\Excel_Icon.png")
        End Select
    End Function

وللتوضيح انا عاوز الاكسيل دي مثلا تدور علي المربعات كلها في 8 ثواني يعني بتلف المربعات كلها في ثانية واحدة وتعيد تاني وهكذا

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

الاساتذة الافاضل 

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

اريد تحريك ليبول او صورة بشكل متتابع بعد وصول العداد الي 0 

بمعني الصورة مثلا بعد 0 تبداء من ليبول معين وبعدها تتحرك بالتتابع علي باقي الليول حتي ينتهي عد مثلا 8 ثواني 

وهذه صورة كروكي لها 

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

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

الاساتذة الافاضل انا اريد تنفيذ الاتي فارجو المساعدة ولو حتي بالفكرة او ترتيب الافكار

اما بعد 

انا مصمم 16 مربع او بمعني اصح 16 ليبول علي شكل مربع وهناك ليبول في المنتصف به عد تنازلي التفاصيل 

المربع بالمنتصف اريد ان يقوم بعملين الاول وقت فتح الفورم يقوم بعد تنازلي 35 ثانية وبعد ال35 ثانية تبداء نقطة او ظل بلون مختلف بالدوران بالتوالي علي ال16 ليبول لمدة 8 ثواني ويظهر بعد ال8 ثواني مربع به عداد 17 ثانية بالناتج الواقف عليه وبعد ال17 يختفي المربع الجديد ويداء ال35 ثانية بالعد مرة اخري وهكذا ولكن الحركة الاقدة تبداء من اخر مكان كان واقف عليها مرفق تصميم مبدائي

وجزاكم الله خيرا

Play.xlsm

اخي الكريم شكرا لك ولكن نفس الوضع لا تزال تقوم بفتح الشاشة التي بالصورة الأولي أما الثانية لم تعد تظهر 

ثانيا لا اريدها ان تحل هذه المشكلة علي جهازي فقط ولكن حين نقله علي جهاز اخر يقوم بفتح الفورم تلقائيا ولا يفتح هذه القوائم اولا 

الاسم والباسورد لدخول البرنامج admin

admin 

أما الدخول للبرمجة 

ashraf

dim

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

الاساتذة الافاضل والاخوة الاعزاء 

انا عامل الشيت عند فتحه يفتح الفورم في حالة اذا غيرت اسم الشيت او نقلته علي جهاز اخر يقوم بما في الصور الاتية

في حالة الضغط علي enable editing يستطيع اي احد  يعدل علي الشيت او الاكواد وبعد الضغط علي enable content يفتح الفورم طبيعي هل يوجد كود اضعه في الورك اوبن يقوم بعمل هذه الخطوات تلقائيا ام لا وشكرا 

rese.xlsm

تم الحل المشكلة كانت في الجهاز

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

نفس المشكلة يا اخي للتوضيح 

حين الضغط علي زر البرمجة يفتح كما في الصورة 

التعديل يعمل بصورة طبيعة وعند الحفظ يحفظ تبيعي ويظل الشيتين المسميان ب excel مفتوحان لا يغلقان الا اذا  فتحت شيت جديد واغلقته 

نفس المشكلة شكرا لك يمكنني التكيف علي هذا الوضع

بارك الله فيك  تم الحل ولكنه يفتح شيت فارغ ولا يغلق الا إذا فتحت شيت جديد وإغلاقه يغلق

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

الاساتذة الافاضل 

ظهر لي مشكلة غريبة بعد اما انتهيت من البرنامج جعلته يفتح تلقائي من loginformبيوزر نيم وباسورد وكل ده تمام 

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

username:admin

passwored:admin

هل يوجد حل ام لا وشكرا

dwork.xlsm

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

شكرا لك يا استاذ محمد 

ولكن كيف انفذ هذا الكود وهناك شئ اخر النموذج يمكنه ان يغلق ويفتح اكثر من مرةفي نفس اليوم وقتها سيضيف قيمتها اكثر من مرة وانا احتاجها تحتفظ باخر قيمة لها قبل اليوم الجديد حتي ولو بخمس دقائق

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

الاخوة الاعزاء والاساتذة الافاضل 

احب ان استفسر عن امكانية تثبيت قيمة ليبول او تكست بوكس التفاصيل كالاتي

انا عامل ليبول مخفي بيستدعي مجموع المشتريات ويطرح منها مجموع المبيعات 

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

Me.Label3.Caption = Val(Me.Label3.Caption) + Val(Me.de.Caption)

المطلوب ان اذا انتهي اليوم علي قيمة معينه في label 3 يثيت هذه القيمة في اليوم الجديد ويجمعها مع متغيرات de

ولكم جزيل الشكر والعرفان

de.xlsm

الحمد لله الذي وفقني للحل 

اولا احب اشكر الاستاذ محمد صالح لانه ساعدني كثيرا بهذه الفكرة 

ثانيا تم حل المشكلة بالكود الاتي 

Dim sc As Integer
sc = customersSheet.Range("A10000").End(xlUp).Row + 1
Dim c, cv As Range
    Dim firstAddress, nfe As String
    Dim f, nf As Integer
    Dim x As Integer
    Dim Y As Integer
    Dim last, last1, lse As Integer
last = SelesSheet.Range("A10000").End(xlUp).Row + 1
last1 = ShortfallsSheet.Range("A10000").End(xlUp).Row + 1
For i = 0 To ListBox1.ListCount - 1
ShortfallsSheet.Range("O1").Value = Me.ListBox1.List(i, 4)
lse = ShortfallsSheet.Range("N1").Value
nfe = Me.ListBox1.List(i, 4)


       f = Me.ListBox1.List(i, 3)
       x = Me.ListBox1.List(i, 1)
       With ItemsSheet.Range("B:B")
        Set c = .Find(f, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
        Y = ItemsSheet.Cells(c.Row, "D").Value
            Y = Y - x
        a = ItemsSheet.Cells(c.Row, "A").Value
            a = a
        b = ItemsSheet.Cells(c.Row, "B").Value
            b = b
        cc = ItemsSheet.Cells(c.Row, "C").Value
            cc = cc
        d = ItemsSheet.Cells(c.Row, "D").Value
            d = d
        e = ItemsSheet.Cells(c.Row, "E").Value
            e = e
        ff = ItemsSheet.Cells(c.Row, "F").Value
            ff = ff
        g = ItemsSheet.Cells(c.Row, "G").Value
            gg = gg
        j = ItemsSheet.Cells(c.Row, "J").Value
            j = j
SelesSheet.Cells(last, "I").Value = Me.ListBox1.List(i, 4)
SelesSheet.Cells(last, "J").Value = Me.ListBox1.List(i, 3)
SelesSheet.Cells(last, "K").Value = Me.ListBox1.List(i, 2)
SelesSheet.Cells(last, "L").Value = Me.ListBox1.List(i, 1)
SelesSheet.Cells(last, "M").Value = Me.ListBox1.List(i, 0)
ItemsSheet.Cells(c.Row, "D").Value = Y
last = last + 1
End If
End With
Next i
 Sheets("Shortfalls").Select
For Each hh In Range("a1:a" & Range("a10000").End(xlUp).Row)
If hh Like nfe & "*" Then
ShortfallsSheet.Cells(lse, "D").Value = d - x

ElseIf d <= j Then
Exit For
ShortfallsSheet.Cells(last1, "A").Value = a
ShortfallsSheet.Cells(last1, "B").Value = b
ShortfallsSheet.Cells(last1, "C").Value = cc
ShortfallsSheet.Cells(last1, "D").Value = d - x
ShortfallsSheet.Cells(last1, "E").Value = e
ShortfallsSheet.Cells(last1, "F").Value = ff
ShortfallsSheet.Cells(last1, "G").Value = g
last1 = last1 + 1
End If
Next
    Dim ls1 As Integer
    Dim ls2 As Integer
ls1 = SelesSheet.Range("A10000").End(xlUp).Row + 1
ls2 = SelesSheet.Range("I10000").End(xlUp).Row
For s = ls1 To ls2
SelesSheet.Cells(ls1, "A").Value = Me.TextBox1.Value
SelesSheet.Cells(ls1, "B").Value = Me.TextBox2.Value
SelesSheet.Cells(ls1, "C").Value = Me.TextBox3.Value
SelesSheet.Cells(ls1, "D").Value = Me.ComboBox1.Value
SelesSheet.Cells(ls1, "E").Value = Me.TextBox13.Value
SelesSheet.Cells(ls1, "F").Value = Me.TextBox11.Value
SelesSheet.Cells(ls1, "G").Value = Me.TextBox12.Value
SelesSheet.Cells(ls1, "H").Value = Me.TextBox14.Value
SelesSheet.Cells(ls1, "N").Value = Time
customersSheet.Cells(sc, "A").Value = Me.ComboBox1.Value
customersSheet.Cells(sc, "C").Value = Me.TextBox11.Value
customersSheet.Cells(sc, "B").Value = "ãÈíÚÇÊ"
customersSheet.Cells(sc, "D").Value = Me.TextBox12.Value
customersSheet.Cells(sc, "E").Value = Me.TextBox2.Value
customersSheet.Cells(sc, "F").Value = Me.TextBox3.Value
customersSheet.Cells(sc, "G").Value = Time
ls1 = ls1 + 1

Next s
MsgBox "Êã ÇÖÇÝÉ ÇáÈíÇäÇÊ ÈäÌÇÍ", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "ÊÇßíÏ"

اشكر الاستاذ محمد صالح مرة اخري علي نصيحتة