شوقي ربيع

ممكن لو فيها رزالة ترفق ملف أخي شوقي لتطبيق تلك النقطة ، فهي جديدة بالنسبة لي بارك الله فيك أخي الحبيب شوقي ربيع (المتمكن) من عنيا الاثنين مثال بسيط ينقل محتوي الخلايا الي Shapes Option Explicit Sub test() Dim sh As Worksheet: Set sh = Feuil1 Dim i As Byte For i = 1 To 4 sh.Shapes("Rectangle " & i).TextFrame2.TextRange.Characters.Text = sh.Range("A" & i) Next End Sub تحياتي للجميع TEST.rar

السلام عليكم لم افهم لمذا تريد عمل ذلك على Shapes برغم ان عملها على الخلايا اسهل وانسب على العموم هذا كود للكتابة في Shapes الخاصة برقم الوثيقة كمثال يمكنك اعتماده على بقية الخانات بنفس الطريقة Feuil2.Shapes("Shapes هنا اسم ").TextFrame2.TextRange.Characters.Text = "هنا تكتب النتيجة"

السلام عليكم () تستعمل بعد تعريف ماكرو او فونكسيو في الاغلب تضهر لوحدها بعد كتابة اسم الماكرو مثال Sub Tst() MsgBox "السلام عليكم" End Sub وايضا تستعمل عند الاعلان عن مصفوفة Dim Ayer() " في الاغلب تستعمل للعبارات النصية مثل الملف الاول . في الاغلب تاتي بعد ادات او دالة لاعلان الامر او طريقة او تسمية ....... , تاتي ايضا في الاغلب لبعض الدوال للفصل بين عمليات الدالة مثال Cells(1, 1) = 10 ’ تستعمل لشرح امر او كود ما وكل ما يأتي بعدها لا ينفذ range , workaheets,if,else,text في كائنات وادوات ودوال مخزنة في االاوفيس يتم استدعائها حسب حاجتك اليها هذا مجرد شرح مبسط ارجو ان اكون قد اوصلت الفكرة لاني اعرف نفسي لست بارعا في الشرح تحياتي

السلام عليكم لفعل ذلك اولا لازم يكون لديك تصور للمشروع الذي تعمل عليه ثم تقوم بتصميم الازر وخلفية الفورم بالفوتوشوب مثلا ومن بعدها تحتاج الى تعلم الاكواد الازمة لربط الصور بالفورم مثال بسيط هذا المثال يعرظ الازرار بشكل اجمل Option Explicit Sub ImgSH(X As Byte) Dim pth As String pth = ThisWorkbook.Path & "\Image\B" & X & ".bmp" Me.Frame1.Picture = LoadPicture(pth) End Sub Private Sub Frame1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): ImgSH 1: End Sub Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): ImgSH 2: End Sub Private Sub Label2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): ImgSH 3: End Sub Private Sub Label3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): ImgSH 4: End Sub Private Sub Label4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): ImgSH 5: End Sub تم استخدام مجموعة صور للازرار وليبلات في تنفيذ ذلك ملاحظة يجب ان يكون ملف الصور في نفس المجلد مع الملف مثال.rar

السلام عليكم يتم الترحيل اوتوماتيكيا مرة واحدة في اليوم بعد الساعة الرابعة (حسب ساعة الجهاز لديك) ا و ذألك لجميع الاوراق التي ذكرتها في طلبك الاخير الى العمود الذي يليه ثم الى الذي يلي الذي يله وهكذا كل يوم ارجو ان يكون هو المطلوب الاكواد المستعملة Option Explicit Dim Sh As Worksheet, WrSh As Worksheet Sub Envoi() Dim Nm As Byte For Nm = 2 To 7 Set WrSh = ThisWorkbook.Sheets(Nm) Dim Lrw As Long: Lrw = WrSh.Cells(WrSh.Rows.Count, 1).End(xlUp).Row Dim Lcm As Long: Lcm = WrSh.Range("IV1").End(xlToLeft).Column + 1 Dim i As Integer If WrSh.Range("A1") = "" Then Lcm = Lcm - 1 WrSh.Cells(1, Lcm) = Date For i = 2 To Lrw WrSh.Cells(i, Lcm).Value = WrSh.Range("C" & i).Value Next Next End Sub Sub Verification() Dim Nm As Byte For Nm = 2 To 7 Set WrSh = ThisWorkbook.Sheets(Nm) Dim Lcm As Long: Lcm = WrSh.Range("IV1").End(xlToLeft).Column If WrSh.Cells(1, Lcm) = Date Then Exit Sub Next If Time > TimeValue("16:00") Then Envoi End Sub تحياتي للجميع zmzm اوفسينا.rar

السلام عليكم اثراء للموضوع هذا حل عبارة عن فورم به ليست بجميع اسماء الشيتات التي يحويها الملف مع امكانية البحث قائمة بأسماء الشيكات.rar

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

السلام عليكم البرنامج هنا تم تحويله الى ملف تنفيذي واغلب مكافحات الفيروسات للأسف تعتبره فيروس برغم من انه ليس كذألك قم بتعطيل الانتي فيروس عندك قبل التحميل وبعد تثبيت البرنامج فعله من جديد ومن اعدادات الانتي فيروس حدد ان البرنامج موثوق وليس فايرس يدويا تحياتي

السلام عليكم هذا الملف يحوي على شيت لداتا يكون مستقبل البيانات الخارجية في العمود الاول 12 شيت بأسماء اشهر السنة لكي ترحل اليها بيانات الداتا (العمود الاول من الداتا فقط) الترحيل يكون حسب الشهر الحالي (حسب ساعة الجهاز) بحيث يقوم الكود بفحص الشيت المتوافق مع الشهر الحالي ثم يرحل بيانات الداتا الى اول عمود فارغ في ذالك الشيت مرة واحدة فقط في اليوم بعد الساعة الرابعة مساءا عند انتهاء الشهر سيكون لديك اعمدة بعدد ايام ذالك الشهر ورأس كل عمود يكون عبارة عن تاريخ اليوم الاكواد المستعملة Option Explicit Dim Sh As Worksheet, WrSh As Worksheet 'ÝÍÕ ÇáÔíÊ ÇáãÊæÇÝÞ ãÚ ÇáÔåÑ ÇáÍÇáí Function NomFeuil(Mois As Byte) As String Set Sh = ThisWorkbook.Sheets("Data") Dim r As Byte For r = 1 To 12 Select Case Mois Case r NomFeuil = Sh.Range("B" & r): Exit Function End Select Next End Function 'ÊÑÍíá ÚãæÏ ÇáÏÇÇ Çáì Çæá ÚãæÏÝÇÑÛ Ýí ÇáÔíÊ ÇáãÊæÇÝÞ ãÚ ÇáÔåÑ ÇáÍÇáí Sub Envoi() Set Sh = ThisWorkbook.Sheets("Data") Set WrSh = ThisWorkbook.Sheets(NomFeuil(Month(Now))) Dim Lrw As Long: Lrw = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row Dim Lcm As Long: Lcm = WrSh.Cells(1, 16384).End(xlToLeft).Column + 1 Dim i As Integer If WrSh.Range("A1") = "" Then Lcm = Lcm - 1 WrSh.Cells(1, Lcm) = Date For i = 2 To Lrw WrSh.Cells(i, Lcm) = Sh.Range("A" & i) Next End Sub 'ÇáÊÑÍíá ÍÓÈ ÇáæÞÊ Sub Verification() Set WrSh = ThisWorkbook.Sheets(NomFeuil(Month(Now))) Dim Lcm As Long: Lcm = WrSh.Cells(1, 16384).End(xlToLeft).Column If WrSh.Cells(1, Lcm) = Date Then Exit Sub If Time > TimeValue("16:00") Then Envoi End Sub ارجو ان يكون المطلوب تحياتي للجميع Test.rar

السلام عليكم اخواني واحبتي في الله ا/ قنديل الصياد أ/ محمود الشريف أ/ أحمد فضيلة أ/ ياسر خليل أ/عباس السماوي أ/ أم عبدالله أ/ محمد نصري أ/ محمد لطفي أ/حسام عيسي أ/جلال الجمال أ/ وائل أحمد المصري أ/أحمد فؤاد أ/محمد الريفي أ/أبو الاء أ/ سعدعابد أ/ الصديق أ/عبدالله باقشير (( مع حفظ الالفاب )) مروركم اسعدنا وشرفنا كثيرا بارك الله فيكم وجزاكم خيرا جمعيا علي كلماتكم ودعائكم الطيب ومروركم العطر وملاحظاتكم المفيدة وان شاء الله خلال الفترة القادمة بعد حصر ملاحظات استخدام البرنامج نقوم بتعديله بما يتناسب مع الاستخدام العام فلا تترددوا في ابلاغنا بملاحظاتكم او اقتراحاتكم تحياتي للجميع

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

السلام عليكم يوجد في الملف ما طلب بالإضافة الى جواب لسؤال لك عن تعبئة القائمة المنسدلة في موضوع اخر Copie de Test.zip

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

الخطاء هنا هو انك تبحث عن كلمة غير موجودة في عمود البحث انت ملئت بيانات القائمة المنسدلة من العمود e وتبحث عن قيمه في العمود c قم بتغير كود ملى القائمة المسدلة بهذا الكود ComboBox1.List = Worksheets("User").Range("C1").CurrentRegion.Columns("A").Value .وايضا في كود ملى التكسات الانك غير الاعمدة For i = 1 To 5 Me.Controls("TextBox" & i) = sh.Cells(Mh, i + 3) Next

لم افهم سؤالك جيدا لاكني في كود البحث السابق استعملت دالة Match بحيث تبحث عن قيمت الكمبوبكس في العمود الاول ان كنت تريد البحث عن شيء اخر بواسطة التكست بوكس مثلا ماعليك سوى تبديل القيمة التي يستمد منها المتغير ii بياناته ii = Me.ComboBox1 تصبح ii = Me.Tsectbox1

هذه الاكواد المستعملة في الفورم البحث والحذف Dim LsInd As Byte Private Sub UserForm_Initialize() ComboBox1.List = Worksheets("User").Range("A1") _ .CurrentRegion.Columns("A").Value End Sub Private Sub ComboBox1_Change() Dim sh As Worksheet Dim Mh As Long, Lr As Long Dim i As Integer Dim ii If Me.ComboBox1 <> "" Then ii = Me.ComboBox1 Set sh = Sheets("User") With sh Lr = .Cells(Rows.Count, "A").End(xlUp).Row + 1 Mh = WorksheetFunction.Match(ii, .Range("A1:A" & Lr), 0) End With For i = 1 To 5 Me.Controls("TextBox" & i) = sh.Cells(Mh, i) Next LsInd = Me.ComboBox1.ListIndex + 1 'Vlookup function for the textboxes once a value has been selected in ComBox1 'TextBox1 = Application.WorksheetFunction.VLookup(ComboBox1, Range("A2:J2000"), 2, False) 'TextBox2 = Application.WorksheetFunction.VLookup(ComboBox1, Range("A2:J2000"), 3, False) 'TextBox3 = Application.WorksheetFunction.VLookup(ComboBox1, Range("A2:J2000"), 4, False) End Sub Private Sub CommandButton1_Click() Unload Me End Sub Private Sub CommandButton2_Click() Dim sh As Worksheet Set sh = Sheets("User") sh.Range("A" & LsInd & ":E" & LsInd).Delete Shift:=xlUp ' If Me.ComboBox1.ListIndex = -2 Then Exit Sub ' Worksheets("USER").Range("A2").Offset(Me.ComboBox1.ListIndex, 0).Range("A1:J1").Delete Shift:=xlUp End Sub فورم به الحذف - هام.zip

فورم به الحذف - هام.zip

السلام عليكم فورم به الحذف - هام.rar

السلام عليكم الشكر موصول للاخ محمد الريفي لاكن هذا الحل لا ينفع في نسخ الويندو و الاوفيس الفرنسية لذى برمجة لكم هته الدالة لجلب يوم تاريخ بالعربي Option Explicit Function NameJour(MyDate As Date) Dim NamDay As String Dim MyWeekDay As Byte, MyDaye As Byte MyDaye = Day(MyDate) MyWeekDay = Weekday(MyDate - 1 + MyDaye) Select Case MyWeekDay Case 1: NamDay = "الاحد" Case 2: NamDay = "الاثنين" Case 3: NamDay = "الثلاثاء" Case 4: NamDay = "الاربعاء" Case 5: NamDay = "الخميس" Case 6: NamDay = "الجمعة" Case 7: NamDay = "السبت" End Select NameJour = NamDay End Function كل ما عليك هو نسخ هذه الاكواد في ميودل ثم استدعاء الدالة من أي شيت كائي دالة اخرى اسم الدالة يكون NameJour تحياتي Nom de Jour.rar

السلام عليكم يوجد اداة اسمها Spreadsheet تستطيع من خلالها عمل الذي تطلبه وذالك عتمادا عن الاصدار الذي تستعمله لانه من الممكن ان لا تجدها في الادوات الاضافية يجب عليك اولا تحميل وتثبيت Office Web Components يمكنك تحميل من هنا download اولا قم باضافة يوزرفورم جديد وضع داخله هذا الكود Private Sub UserForm_Initialize() Me.Spreadsheet1.Cells.Range("A1:B2").Value = _ ThisWorkbook.Worksheets("Feuil1").Range("A1:B2").Value End Sub ثم اتبع الشرح المصور الاتي اولا كليك يمين على صندوق الادوات بحث عن Microsoft Office Spreadsheet 11.0 ثم حددها واضغط OK تضهر لك ايقونة جديدة مثل ايقونت الاكسل في صندوق الادوات كما في الصورة اضفها بكل بساطة الى الفورم لديك النتيجة النهائية تماما مثل الشيت الحقيقي ملاحظة ان كل من لم يثبت Office Web Components سيضهر له رسالة خطاء في الملف المرفق تحياتي Spreadsheet.rar

السلام عليكم جرب هذا ان شاء الله ينفع Sub test() Dim i As Byte For i = 1 To 27 Me.Controls("C" & i) = "[Forms]![TStu2SBehTeam]![C" & i & "]" Next End Sub

السلام عليكم الملف يعمل بكفاءة ربما لم تخفض من مستوى امان الماكرو

السلام عليكم هذا حل بالاكود لوائح منسدلة مترابطة.rar

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

بسم الله الرحمان الرحيم السلام عليكم جمعة مباركة على الجميع اقدم لكم اليوم طريقة سهلة وعملية لتجميل الازرار في الفورم او حتي في الشيت الطريقة و بكل بساطة تعتمد على تغير نوع الخط ونعتد على اربعة انواع من الخطوط لتحقيق هذا وهذه الاخيرة متوفرة على اغلب الاجهزة الخطوط المستعملة هي wingdigs , wingdings 2 , wingdings 3 , webdings تجدون في المرفق امثلة عملية كما يوجد ايضا ملف PDF يحوي على جميع الارقام والحروف والرموز وما يقابلها عند تغير نوع الخط كل ما عليكم اختيار الشكل الذي تحتاجونه في تصميمكم ملاحظة للأمانة فكرة الموضوع منقولة من احد المواقع الاجنبية كل ما فعلته هو التطبيق جميع الرموز والصورة الممكنة.pdf امثلة عملية.rar تحياتي للجميع